| 1 |
# Developers: ---- |
|
| 2 | ||
| 3 |
# This file defines the parent class of FIMSFit and its potential children. The |
|
| 4 |
# class is an S4 class with accessors and validators but no setters. For more |
|
| 5 |
# details on how to create an S4 class in FIMS please see R/fimsframe.R |
|
| 6 | ||
| 7 |
# TODO: ---- |
|
| 8 | ||
| 9 |
# TODO: Fix "no metadata object found to revise superClass" in sdreportOrList |
|
| 10 |
# TODO: Write more validity checks for FIMSFit |
|
| 11 |
# TODO: Better document the return of [get_estimates()], i.e., columns |
|
| 12 |
# TODO: Decide if the error from is.FIMSFits should be a single FALSE or stop |
|
| 13 |
# TODO: Decide if "total" should be a part of number_of_parameters because it |
|
| 14 |
# can be calculated from fixed_effects + random_effects and would need to |
|
| 15 |
# be calculated in print.FITFims() |
|
| 16 |
# TODO: Determine if report should always use last.par.best |
|
| 17 |
# TODO: Make a helper function to add lower and upper CI for users in estimates |
|
| 18 |
# TODO: Add Terminal SB to print() |
|
| 19 | ||
| 20 |
# methods::setClass: ---- |
|
| 21 | ||
| 22 |
# Need to use an S3 class for the following S4 class |
|
| 23 |
methods::setOldClass(Classes = "package_version") |
|
| 24 |
methods::setOldClass(Classes = "difftime") |
|
| 25 |
methods::setOldClass(Classes = "sdreport") |
|
| 26 |
# Join sdreport and list into a class incase the sdreport is not created |
|
| 27 |
methods::setClassUnion("sdreportOrList", members = c("sdreport", "list"))
|
|
| 28 | ||
| 29 |
methods::setClass( |
|
| 30 |
Class = "FIMSFit", |
|
| 31 |
slots = c( |
|
| 32 |
input = "list", |
|
| 33 |
obj = "list", |
|
| 34 |
opt = "list", |
|
| 35 |
max_gradient = "numeric", |
|
| 36 |
report = "list", |
|
| 37 |
sdreport = "sdreportOrList", |
|
| 38 |
estimates = "tbl_df", |
|
| 39 |
number_of_parameters = "integer", |
|
| 40 |
timing = "difftime", |
|
| 41 |
version = "package_version" |
|
| 42 |
) |
|
| 43 |
) |
|
| 44 | ||
| 45 |
methods::setMethod( |
|
| 46 |
f = "print", |
|
| 47 |
signature = "FIMSFit", |
|
| 48 |
definition = function(x) {
|
|
| 49 | ! |
rt <- as.numeric(x@timing[["time_total"]], units = "secs") |
| 50 | ! |
ru <- "seconds" |
| 51 | ! |
if (rt > 60 * 60 * 24) {
|
| 52 | ! |
rt <- rt / (60 * 60 * 24) |
| 53 | ! |
ru <- "days" |
| 54 | ! |
} else if (rt > 60 * 60) {
|
| 55 | ! |
rt <- rt / (60 * 60) |
| 56 | ! |
ru <- "hours" |
| 57 | ! |
} else if (rt > 60) {
|
| 58 | ! |
rt <- rt / 60 |
| 59 | ! |
ru <- "minutes" |
| 60 |
} |
|
| 61 | ||
| 62 | ! |
number_of_parameters <- paste( |
| 63 | ! |
names(x@number_of_parameters), |
| 64 | ! |
x@number_of_parameters, |
| 65 | ! |
sep = "=" |
| 66 |
) |
|
| 67 | ! |
div_digit <- cli::cli_div(theme = list(.val = list(digits = 5))) |
| 68 | ! |
terminal_ssb <- sapply( |
| 69 | ! |
x@report[["ssb"]], |
| 70 | ! |
function(y) utils::tail(y, 1) |
| 71 |
) |
|
| 72 | ! |
cli::cli_inform(c( |
| 73 | ! |
"i" = "FIMS model version: {.val {x@version}}",
|
| 74 | ! |
"i" = "Total run time was {.val {rt}} {ru}",
|
| 75 | ! |
"i" = "Number of parameters: {number_of_parameters}",
|
| 76 | ! |
"i" = "Maximum gradient= {.val {x@max_gradient}}",
|
| 77 | ! |
"i" = "Negative log likelihood (NLL):", |
| 78 | ! |
"*" = "Marginal NLL= {.val {x@opt$objective}}",
|
| 79 | ! |
"*" = "Total NLL= {.val {x@report$jnll}}",
|
| 80 |
# TODO: x@rep[["sb"]] does not exist |
|
| 81 | ! |
"i" = "Terminal SB= " |
| 82 |
)) |
|
| 83 | ! |
cli::cli_end(div_digit) |
| 84 |
} |
|
| 85 |
) |
|
| 86 | ||
| 87 |
# methods::setMethod: accessors ---- |
|
| 88 | ||
| 89 |
# Accessor functions for a FIMSFit object |
|
| 90 |
# 1 methods::setGeneric() per slot but potentially >1 methods::setMethod() per methods::setGeneric() |
|
| 91 | ||
| 92 |
#' Get a slot in a FIMSFit object |
|
| 93 |
#' |
|
| 94 |
#' There is an accessor function for each slot in the S4 class `FIMSFit`, where |
|
| 95 |
#' the function is named `get_*()` and the star can be replaced with the slot |
|
| 96 |
#' name, e.g., [get_input()]. These accessor functions are the preferred way |
|
| 97 |
#' to access objects stored in the available slots. |
|
| 98 |
#' |
|
| 99 |
#' @param x Output returned from [fit_fims()]. |
|
| 100 |
#' @name get_FIMSFit |
|
| 101 |
#' @seealso |
|
| 102 |
#' * [fit_fims()] |
|
| 103 |
#' * [create_default_parameters()] |
|
| 104 |
NULL |
|
| 105 | ||
| 106 |
#' @return |
|
| 107 |
#' [get_input()] returns the list that was used to fit the FIMS model, which |
|
| 108 |
#' is the returned object from [create_default_parameters()]. |
|
| 109 |
#' @export |
|
| 110 |
#' @rdname get_FIMSFit |
|
| 111 |
#' @keywords fit_fims |
|
| 112 | ! |
methods::setGeneric("get_input", function(x) standardGeneric("get_input"))
|
| 113 |
#' @rdname get_FIMSFit |
|
| 114 |
#' @keywords fit_fims |
|
| 115 | ! |
methods::setMethod("get_input", "FIMSFit", function(x) x@input)
|
| 116 | ||
| 117 |
#' @return |
|
| 118 |
#' [get_report()] returns the TMB report, where anything that is flagged as |
|
| 119 |
#' reportable in the C++ code is returned. |
|
| 120 |
#' @export |
|
| 121 |
#' @rdname get_FIMSFit |
|
| 122 |
#' @keywords fit_fims |
|
| 123 | ! |
methods::setGeneric("get_report", function(x) standardGeneric("get_report"))
|
| 124 |
#' @rdname get_FIMSFit |
|
| 125 |
#' @keywords fit_fims |
|
| 126 | ! |
methods::setMethod("get_report", "FIMSFit", function(x) x@report)
|
| 127 | ||
| 128 |
#' @return |
|
| 129 |
#' [get_obj()] returns the output from [TMB::MakeADFun()]. |
|
| 130 |
#' @export |
|
| 131 |
#' @rdname get_FIMSFit |
|
| 132 |
#' @keywords fit_fims |
|
| 133 | ! |
methods::setGeneric("get_obj", function(x) standardGeneric("get_obj"))
|
| 134 |
#' @rdname get_FIMSFit |
|
| 135 |
#' @keywords fit_fims |
|
| 136 | ! |
methods::setMethod("get_obj", "FIMSFit", function(x) x@obj)
|
| 137 | ||
| 138 |
#' @return |
|
| 139 |
#' [get_opt()] returns the output from [nlminb()], which is the minimizer used |
|
| 140 |
#' in [fit_fims()]. |
|
| 141 |
#' @export |
|
| 142 |
#' @rdname get_FIMSFit |
|
| 143 |
#' @keywords fit_fims |
|
| 144 | ! |
methods::setGeneric("get_opt", function(x) standardGeneric("get_opt"))
|
| 145 |
#' @rdname get_FIMSFit |
|
| 146 |
#' @keywords fit_fims |
|
| 147 | ! |
methods::setMethod("get_opt", "FIMSFit", function(x) x@opt)
|
| 148 | ||
| 149 |
#' @return |
|
| 150 |
#' [get_max_gradient()] returns the maximum gradient found when optimizing the |
|
| 151 |
#' model. |
|
| 152 |
#' @export |
|
| 153 |
#' @rdname get_FIMSFit |
|
| 154 |
#' @keywords fit_fims |
|
| 155 | ! |
methods::setGeneric("get_max_gradient", function(x) standardGeneric("get_max_gradient"))
|
| 156 |
#' @rdname get_FIMSFit |
|
| 157 |
#' @keywords fit_fims |
|
| 158 | ! |
methods::setMethod("get_max_gradient", "FIMSFit", function(x) x@max_gradient)
|
| 159 | ||
| 160 | ||
| 161 |
#' @return |
|
| 162 |
#' [get_sdreport()] returns the list from [TMB::sdreport()]. |
|
| 163 |
#' @export |
|
| 164 |
#' @rdname get_FIMSFit |
|
| 165 |
#' @keywords fit_fims |
|
| 166 | ! |
methods::setGeneric("get_sdreport", function(x) standardGeneric("get_sdreport"))
|
| 167 |
#' @rdname get_FIMSFit |
|
| 168 |
#' @keywords fit_fims |
|
| 169 | ! |
methods::setMethod("get_sdreport", "FIMSFit", function(x) x@sdreport)
|
| 170 | ||
| 171 |
#' @return |
|
| 172 |
#' [get_estimates()] returns a tibble of parameter values and their |
|
| 173 |
#' uncertainties from a fitted model. |
|
| 174 |
#' @export |
|
| 175 |
#' @rdname get_FIMSFit |
|
| 176 |
#' @keywords fit_fims |
|
| 177 | ! |
methods::setGeneric("get_estimates", function(x) standardGeneric("get_estimates"))
|
| 178 |
#' @rdname get_FIMSFit |
|
| 179 |
#' @keywords fit_fims |
|
| 180 | ! |
methods::setMethod("get_estimates", "FIMSFit", function(x) x@estimates)
|
| 181 | ||
| 182 |
#' @return |
|
| 183 |
#' [get_number_of_parameters()] returns a vector of integers specifying the |
|
| 184 |
#' number of fixed-effect parameters and the number of random-effect parameters |
|
| 185 |
#' in the model. |
|
| 186 |
#' @export |
|
| 187 |
#' @rdname get_FIMSFit |
|
| 188 |
#' @keywords fit_fims |
|
| 189 |
methods::setGeneric( |
|
| 190 |
"get_number_of_parameters", |
|
| 191 | ! |
function(x) standardGeneric("get_number_of_parameters")
|
| 192 |
) |
|
| 193 |
#' @rdname get_FIMSFit |
|
| 194 |
#' @keywords fit_fims |
|
| 195 |
methods::setMethod( |
|
| 196 |
"get_number_of_parameters", |
|
| 197 |
"FIMSFit", |
|
| 198 | ! |
function(x) x@get_number_of_parameters |
| 199 |
) |
|
| 200 | ||
| 201 |
#' @return |
|
| 202 |
#' [get_timing()] returns the amount of time it took to run the model in |
|
| 203 |
#' seconds as a `difftime` object. |
|
| 204 |
#' @export |
|
| 205 |
#' @rdname get_FIMSFit |
|
| 206 |
#' @keywords fit_fims |
|
| 207 | ! |
methods::setGeneric("get_timing", function(x) standardGeneric("get_timing"))
|
| 208 |
#' @rdname get_FIMSFit |
|
| 209 |
#' @keywords fit_fims |
|
| 210 | ! |
methods::setMethod("get_timing", "FIMSFit", function(x) x@timing)
|
| 211 | ||
| 212 |
#' @return |
|
| 213 |
#' [get_version()] returns the `package_version` of FIMS that was used to fit |
|
| 214 |
#' the model. |
|
| 215 |
#' @export |
|
| 216 |
#' @rdname get_FIMSFit |
|
| 217 |
#' @keywords fit_fims |
|
| 218 | ! |
methods::setGeneric("get_version", function(x) standardGeneric("get_version"))
|
| 219 |
#' @rdname get_FIMSFit |
|
| 220 |
#' @keywords fit_fims |
|
| 221 | ! |
methods::setMethod("get_version", "FIMSFit", function(x) x@version)
|
| 222 | ||
| 223 |
# methods::setValidity ---- |
|
| 224 | ||
| 225 |
methods::setValidity( |
|
| 226 |
Class = "FIMSFit", |
|
| 227 |
method = function(object) {
|
|
| 228 |
errors <- character() |
|
| 229 | ||
| 230 |
# Check that obj is from TMB::MakeADFun() |
|
| 231 |
TMB_MakeADFun_names <- c( |
|
| 232 |
"par", "fn", "gr", "he", "hessian", "method", "retape", "env", "report", |
|
| 233 |
"simulate" |
|
| 234 |
) |
|
| 235 |
if (!setequal(names(object@obj), TMB_MakeADFun_names)) {
|
|
| 236 |
errors <- c( |
|
| 237 |
errors, |
|
| 238 |
"obj must be a list returned from TMB::MakeADFun() but it does not |
|
| 239 |
appear to be so because it does not have the standard names." |
|
| 240 |
) |
|
| 241 |
} |
|
| 242 | ||
| 243 |
# Return |
|
| 244 |
if (length(errors) == 0) {
|
|
| 245 |
return(TRUE) |
|
| 246 |
} else {
|
|
| 247 |
return(errors) |
|
| 248 |
} |
|
| 249 |
} |
|
| 250 |
) |
|
| 251 | ||
| 252 |
# methods::setMethod: is.FIMSFit ---- |
|
| 253 | ||
| 254 |
#' Check if an object is of class FIMSFit |
|
| 255 |
#' |
|
| 256 |
#' @param x Returned list from [fit_fims()]. |
|
| 257 |
#' @keywords fit_fims |
|
| 258 |
#' @export |
|
| 259 |
is.FIMSFit <- function(x) {
|
|
| 260 | ! |
inherits(x, "FIMSFit") |
| 261 |
} |
|
| 262 | ||
| 263 |
#' Check if an object is a list of FIMSFit objects |
|
| 264 |
#' |
|
| 265 |
#' @param x List of fits returned from multiple calls to [fit_fims()]. |
|
| 266 |
#' @keywords fit_fims |
|
| 267 |
#' @export |
|
| 268 |
is.FIMSFits <- function(x) {
|
|
| 269 | ! |
if (!is.list(x)) {
|
| 270 | ! |
cli::cli_warn( |
| 271 | ! |
message = c("x" = "{.par x} is not a list -- something went wrong.")
|
| 272 |
) |
|
| 273 | ! |
return(FALSE) |
| 274 |
} |
|
| 275 | ! |
all(sapply(x, function(i) inherits(i, "FIMSFit"))) |
| 276 |
} |
|
| 277 | ||
| 278 |
# Constructors ---- |
|
| 279 | ||
| 280 |
#' Class constructors for class `FIMSFit` and associated child classes |
|
| 281 |
#' |
|
| 282 |
#' Create an object with the class of `FIMSFit` after running a FIMS model. This |
|
| 283 |
#' is typically done within [fit_fims()] but it can be create manually by the |
|
| 284 |
#' user if they have used their own bespoke code to fit a FIMS model. |
|
| 285 |
#' |
|
| 286 |
#' @inheritParams fit_fims |
|
| 287 |
#' @param obj An object returned from [TMB::MakeADFun()]. |
|
| 288 |
#' @param opt An object returned from an optimizer, typically from |
|
| 289 |
#' [stats::nlminb()], used to fit a TMB model. |
|
| 290 |
#' @param sdreport An object of the `sdreport` class as returned from |
|
| 291 |
#' [TMB::sdreport()]. |
|
| 292 |
#' @param timing A vector of at least length one, where all entries are of the |
|
| 293 |
#' `timediff` class and at least one is named "time_total". This information |
|
| 294 |
#' is available in [fit_fims()] and added to this argument internally but if |
|
| 295 |
#' you are a power user you can calculate the time it took to run your model |
|
| 296 |
#' by subtracting two [Sys.time()] objects. |
|
| 297 |
#' @param version The version of FIMS that was used to optimize the model. If |
|
| 298 |
#' [fit_fims()] was not used to optimize the model, then the default is to |
|
| 299 |
#' use the current version of the package that is loaded. |
|
| 300 |
#' |
|
| 301 |
#' @return |
|
| 302 |
#' An object with an S4 class of `FIMSFit` is returned. The object will have the |
|
| 303 |
#' following slots: |
|
| 304 |
#' \describe{
|
|
| 305 |
#' \item{\code{input}:}{
|
|
| 306 |
#' A list containing the model setup in the same form it was passed. |
|
| 307 |
#' } |
|
| 308 |
#' \item{\code{obj}:}{
|
|
| 309 |
#' A list returned from [TMB::MakeADFun()] in the same form it was passed. |
|
| 310 |
#' } |
|
| 311 |
#' \item{\code{opt}:}{
|
|
| 312 |
#' A list containing the optimized model in the same form it was passed. |
|
| 313 |
#' } |
|
| 314 |
#' \item{\code{max_gradient}:}{
|
|
| 315 |
#' The maximum gradient found when optimizing the model. The default is |
|
| 316 |
#' `NA`, which means that the model was not optimized. |
|
| 317 |
#' } |
|
| 318 |
#' \item{\code{report}:}{
|
|
| 319 |
#' A list containing the model report from `obj[["report"]]()`. |
|
| 320 |
#' } |
|
| 321 |
#' \item{\code{sdreport}:}{
|
|
| 322 |
#' A object with the `sdreport` class containing the output from |
|
| 323 |
#' `TMB::sdreport(obj)`. |
|
| 324 |
#' } |
|
| 325 |
#' \item{\code{estimates}:}{
|
|
| 326 |
#' A table of parameter values and their uncertainty. |
|
| 327 |
#' } |
|
| 328 |
#' \item{\code{timing}:}{
|
|
| 329 |
#' The length of time it took to run the model if it was optimized. |
|
| 330 |
#' } |
|
| 331 |
#' \item{\code{version}:}{
|
|
| 332 |
#' The package version of FIMS used to fit the model or at least the |
|
| 333 |
#' version used to create this output, which will not always be the same |
|
| 334 |
#' if you are running this function yourself. |
|
| 335 |
#' } |
|
| 336 |
#' } |
|
| 337 |
#' @keywords fit_fims |
|
| 338 |
#' @export |
|
| 339 |
FIMSFit <- function( |
|
| 340 |
input, |
|
| 341 |
obj, |
|
| 342 |
opt = list(), |
|
| 343 |
sdreport = list(), |
|
| 344 |
timing = c("time_total" = as.difftime(0, units = "secs")),
|
|
| 345 |
version = utils::packageVersion("FIMS")
|
|
| 346 |
) {
|
|
| 347 |
# What we aspire the estimate table to look like |
|
| 348 | ! |
estimates_outline <- dplyr::tibble( |
| 349 | ! |
label = character(), |
| 350 | ! |
fleet = character(), |
| 351 | ! |
age = numeric(), |
| 352 | ! |
time = numeric(), |
| 353 | ! |
initial = numeric(), |
| 354 | ! |
estimate = numeric(), |
| 355 | ! |
uncertainty = numeric(), |
| 356 | ! |
likelihood = numeric(), |
| 357 | ! |
gradient = numeric(), |
| 358 | ! |
estimated = logical() |
| 359 |
) |
|
| 360 | ! |
rm(estimates_outline) |
| 361 | ||
| 362 |
# Determine the number of parameters |
|
| 363 | ! |
n_total <- length(obj[["env"]][["last.par.best"]]) |
| 364 | ! |
n_fixed_effects <- length(obj[["par"]]) |
| 365 | ! |
number_of_parameters <- c( |
| 366 | ! |
total = n_total, |
| 367 | ! |
fixed_effects = n_fixed_effects, |
| 368 | ! |
random_effects = n_total - n_fixed_effects |
| 369 |
) |
|
| 370 | ! |
rm(n_total, n_fixed_effects) |
| 371 | ||
| 372 |
# Calculate the maximum gradient |
|
| 373 | ! |
max_gradient <- if (length(opt) > 0) {
|
| 374 | ! |
max(abs(obj[["gr"]](opt[["par"]]))) |
| 375 |
} else {
|
|
| 376 | ! |
NA_real_ |
| 377 |
} |
|
| 378 | ||
| 379 |
# Rename parameters instead of "p" |
|
| 380 | ! |
parameter_names <- names(get_parameter_names(obj[["par"]])) |
| 381 | ! |
names(obj[["par"]]) <- parameter_names |
| 382 | ||
| 383 |
# Get the report |
|
| 384 | ! |
report <- if (length(opt) == 0) {
|
| 385 | ! |
obj[["report"]](obj[["env"]][["last.par.best"]]) |
| 386 |
} else {
|
|
| 387 | ! |
obj[["report"]]() |
| 388 |
} |
|
| 389 | ||
| 390 | ! |
if (length(sdreport) > 0) {
|
| 391 | ! |
names(sdreport[["par.fixed"]]) <- parameter_names |
| 392 | ! |
dimnames(sdreport[["cov.fixed"]]) <- list(parameter_names, parameter_names) |
| 393 | ! |
std <- summary(sdreport) |
| 394 | ! |
estimates <- tibble::tibble( |
| 395 | ! |
as.data.frame(std) |
| 396 |
) |> |
|
| 397 | ! |
dplyr::rename(value = "Estimate", se = "Std. Error") |> |
| 398 | ! |
dplyr::mutate( |
| 399 | ! |
name = dimnames(std)[[1]], |
| 400 | ! |
.before = "value" |
| 401 |
) |
|
| 402 |
} else {
|
|
| 403 | ! |
estimates <- tibble::tibble( |
| 404 | ! |
name = names(obj[["par"]]), |
| 405 | ! |
value = obj[["env"]][["parList"]]()[["p"]], |
| 406 | ! |
se = NA_real_ |
| 407 |
) |
|
| 408 |
} |
|
| 409 | ||
| 410 | ! |
fit <- methods::new( |
| 411 | ! |
"FIMSFit", |
| 412 | ! |
input = input, |
| 413 | ! |
obj = obj, |
| 414 | ! |
opt = opt, |
| 415 | ! |
max_gradient = max_gradient, |
| 416 | ! |
report = report, |
| 417 | ! |
sdreport = sdreport, |
| 418 | ! |
estimates = estimates, |
| 419 | ! |
number_of_parameters = number_of_parameters, |
| 420 | ! |
timing = timing, |
| 421 | ! |
version = version |
| 422 |
) |
|
| 423 | ! |
fit |
| 424 |
} |
|
| 425 | ||
| 426 |
#' Fit a FIMS model (BETA) |
|
| 427 |
#' |
|
| 428 |
#' @param input Input list as returned by [initialize_fims()]. |
|
| 429 |
#' @param get_sd A boolean specifying if the [TMB::sdreport()] should be |
|
| 430 |
#' calculated? |
|
| 431 |
#' @param save_sd A logical, with the default `TRUE`, indicating whether the |
|
| 432 |
#' sdreport is returned in the output. If `FALSE`, the slot for the report |
|
| 433 |
#' will be empty. |
|
| 434 |
#' @param number_of_loops A positive integer specifying the number of |
|
| 435 |
#' iterations of the optimizer that will be performed to improve the |
|
| 436 |
#' gradient. The default is three, leading to four total optimization steps. |
|
| 437 |
#' @param optimize Optimize (TRUE, default) or (FALSE) build and return |
|
| 438 |
#' a list containing the obj and report slot. |
|
| 439 |
#' @param number_of_newton_steps The number of Newton steps using the inverse |
|
| 440 |
#' Hessian to do after optimization. Not yet implemented. |
|
| 441 |
#' @param control A list of optimizer settings passed to [stats::nlminb()]. The |
|
| 442 |
#' the default is a list of length three with `eval.max = 1000`, |
|
| 443 |
#' `iter.max = 10000`, and `trace = 0`. |
|
| 444 |
#' @param filename Character string giving a file name to save the fitted |
|
| 445 |
#' object as an RDS object. Defaults to 'fit.RDS', and a value of NULL |
|
| 446 |
#' indicates not to save it. If specified, it must end in .RDS. The file is |
|
| 447 |
#' written to folder given by `input[["path"]]`. Not yet implemented. |
|
| 448 |
#' @return |
|
| 449 |
#' An object of class `FIMSFit` is returned, where the structure is the same |
|
| 450 |
#' regardless if `optimize = TRUE` or not. Uncertainty information is only |
|
| 451 |
#' included in the `estimates` slot if `get_sd = TRUE`. |
|
| 452 |
#' @seealso |
|
| 453 |
#' * [FIMSFit()] |
|
| 454 |
#' @details This function is a beta version still and subject to change |
|
| 455 |
#' without warning. |
|
| 456 |
#' @keywords fit_fims |
|
| 457 |
#' @export |
|
| 458 |
fit_fims <- function(input, |
|
| 459 |
get_sd = TRUE, |
|
| 460 |
save_sd = TRUE, |
|
| 461 |
number_of_loops = 3, |
|
| 462 |
optimize = TRUE, |
|
| 463 |
number_of_newton_steps = 0, |
|
| 464 |
control = list( |
|
| 465 |
eval.max = 10000, |
|
| 466 |
iter.max = 10000, |
|
| 467 |
trace = 0 |
|
| 468 |
), |
|
| 469 |
filename = NULL) {
|
|
| 470 | ! |
if (!is.null(input$random)) {
|
| 471 | ! |
cli::cli_abort("Random effects declared but are not implemented yet.")
|
| 472 |
} |
|
| 473 | ! |
if (number_of_newton_steps > 0) {
|
| 474 | ! |
cli::cli_abort("Newton steps not implemented yet.")
|
| 475 |
} |
|
| 476 | ! |
if (number_of_loops < 0) {
|
| 477 | ! |
cli::cli_abort("number_of_loops ({.par {number_of_loops}}) must be >= 0.")
|
| 478 |
} |
|
| 479 | ! |
obj <- MakeADFun( |
| 480 | ! |
data = list(), |
| 481 | ! |
parameters = input$parameters, |
| 482 | ! |
map = input$map, |
| 483 | ! |
random = input$random, |
| 484 | ! |
DLL = "FIMS", |
| 485 | ! |
silent = TRUE |
| 486 |
) |
|
| 487 | ! |
if (!optimize) {
|
| 488 | ! |
initial_fit <- FIMSFit( |
| 489 | ! |
input = input, |
| 490 | ! |
obj = obj, |
| 491 | ! |
timing = c("time_total" = as.difftime(0, units = "secs"))
|
| 492 |
) |
|
| 493 | ! |
return(initial_fit) |
| 494 |
} |
|
| 495 | ! |
if (!is_fims_verbose()) {
|
| 496 | ! |
control$trace <- 0 |
| 497 |
} |
|
| 498 |
## optimize and compare |
|
| 499 | ! |
cli::cli_inform(c("v" = "Starting optimization ..."))
|
| 500 | ! |
t0 <- Sys.time() |
| 501 | ! |
opt <- with( |
| 502 | ! |
obj, |
| 503 | ! |
nlminb( |
| 504 | ! |
start = par, |
| 505 | ! |
objective = fn, |
| 506 | ! |
gradient = gr, |
| 507 | ! |
control = control |
| 508 |
) |
|
| 509 |
) |
|
| 510 | ! |
maxgrad0 <- maxgrad <- max(abs(obj$gr(opt$par))) |
| 511 | ! |
if (number_of_loops > 0) {
|
| 512 | ! |
cli::cli_inform(c( |
| 513 | ! |
"i" = "Restarting optimizer {number_of_loops} times to improve gradient."
|
| 514 |
)) |
|
| 515 | ! |
for (ii in 1:number_of_loops) {
|
| 516 |
# control$trace is reset to zero regardless of verbosity because the |
|
| 517 |
# differences in values printed out using control$trace will be |
|
| 518 |
# negligible between these different runs and is not worth printing |
|
| 519 | ! |
control$trace <- 0 |
| 520 | ! |
opt <- with( |
| 521 | ! |
obj, |
| 522 | ! |
nlminb( |
| 523 | ! |
start = opt[["par"]], |
| 524 | ! |
objective = fn, |
| 525 | ! |
gradient = gr, |
| 526 | ! |
control = control |
| 527 |
) |
|
| 528 |
) |
|
| 529 | ! |
maxgrad <- max(abs(obj[["gr"]](opt[["par"]]))) |
| 530 |
} |
|
| 531 | ! |
div_digit <- cli::cli_div(theme = list(.val = list(digits = 5))) |
| 532 | ! |
cli::cli_inform(c( |
| 533 | ! |
"i" = "Maximum gradient went from {.val {maxgrad0}} to
|
| 534 | ! |
{.val {maxgrad}} after {number_of_loops} steps."
|
| 535 |
)) |
|
| 536 | ! |
cli::cli_end(div_digit) |
| 537 |
} |
|
| 538 | ! |
time_optimization <- Sys.time() - t0 |
| 539 | ! |
cli::cli_inform(c("v" = "Finished optimization"))
|
| 540 | ||
| 541 | ! |
time_sdreport <- NA |
| 542 | ! |
if (get_sd) {
|
| 543 | ! |
t2 <- Sys.time() |
| 544 | ! |
sdreport <- TMB::sdreport(obj) |
| 545 | ! |
cli::cli_inform(c("v" = "Finished sdreport"))
|
| 546 | ! |
time_sdreport <- Sys.time() - t2 |
| 547 |
} else {
|
|
| 548 | ! |
sdreport <- list() |
| 549 | ! |
time_sdreport <- as.difftime(0, units = "secs") |
| 550 |
} |
|
| 551 | ||
| 552 | ! |
timing <- c( |
| 553 | ! |
time_optimization = time_optimization, |
| 554 | ! |
time_sdreport = time_sdreport, |
| 555 | ! |
time_total = Sys.time() - t0 |
| 556 |
) |
|
| 557 | ! |
fit <- FIMSFit( |
| 558 | ! |
input = input, |
| 559 | ! |
obj = obj, |
| 560 | ! |
opt = opt, |
| 561 | ! |
sdreport = sdreport, |
| 562 | ! |
timing = timing |
| 563 |
) |
|
| 564 | ! |
print(fit) |
| 565 | ! |
if (!is.null(filename)) {
|
| 566 | ! |
cli::cli_warn(c( |
| 567 | ! |
"i" = "Saving output to file is not yet implemented." |
| 568 |
)) |
|
| 569 |
# saveRDS(fit, file=file.path(input[["path"]], filename)) |
|
| 570 |
} |
|
| 571 | ! |
return(fit) |
| 572 |
} |
|
| 573 | ||
| 574 |
# we create an as.list method for this new FIMSFit |
|
| 575 |
methods::setMethod("as.list", signature(x = "FIMSFit"), function(x) {
|
|
| 576 | ! |
mapply( |
| 577 | ! |
function(y) {
|
| 578 |
# apply as.list if the slot is again an user-defined object |
|
| 579 |
# therefore, as.list gets applied recursively |
|
| 580 | ! |
if (inherits(slot(x, y), "FIMSFit")) {
|
| 581 | ! |
as.list(slot(x, y)) |
| 582 |
} else {
|
|
| 583 |
# otherwise just return the slot |
|
| 584 | ! |
slot(x, y) |
| 585 |
} |
|
| 586 |
}, |
|
| 587 | ! |
slotNames(class(x)), |
| 588 | ! |
SIMPLIFY = FALSE |
| 589 |
) |
|
| 590 |
}) |
| 1 |
#' Validity checks for distributions |
|
| 2 |
#' |
|
| 3 |
#' This function checks the validity of arguments passed to functions that |
|
| 4 |
#' relate to distributions within the Fisheries Integrated Modeling System |
|
| 5 |
#' (FIMS). This function is designed to fail early only once, otherwise it goes |
|
| 6 |
#' through many checks before reporting the results in an attempt to give the |
|
| 7 |
#' user the most information possible. If it were to fail on every mistake, |
|
| 8 |
#' then the user might have to iterate through multiple changes to their input |
|
| 9 |
#' values. Sometimes, their mistakes might take quite a bit of time to make it |
|
| 10 |
#' to this function or worse they might be running things on the cloud and not |
|
| 11 |
#' have immediate access to the report. Therefore, we feel that providing the |
|
| 12 |
#' most information possible is the best way forward. |
|
| 13 |
#' |
|
| 14 |
#' @param args A named list of input arguments that must contain at least |
|
| 15 |
#' `family` and `sd`. `data_type` is only needed for some upstream functions. |
|
| 16 |
#' @seealso |
|
| 17 |
#' This function is used in the following functions: |
|
| 18 |
#' * [initialize_data_distribution()] |
|
| 19 |
#' * [initialize_process_distribution()] |
|
| 20 |
#' @noRd |
|
| 21 |
#' @return |
|
| 22 |
#' If successful, `TRUE` is invisibly returned. If unsuccessful, |
|
| 23 |
#' [cli::cli_abort()] is used to return the relevant error messages. |
|
| 24 |
check_distribution_validity <- function(args) {
|
|
| 25 |
# Separate objects from args |
|
| 26 | ! |
family <- args[["family"]] |
| 27 | ! |
sd <- args[["sd"]] |
| 28 |
# Optional argument data_type |
|
| 29 | ! |
data_type <- args[["data_type"]] |
| 30 | ! |
check_present <- purrr::map_vec(list("family" = family, "sd" = sd), is.null)
|
| 31 | ||
| 32 |
# Set up global rules |
|
| 33 |
# FIXME: Move this to a data item in the package so it can be used everywhere |
|
| 34 |
# Could do a call to all data objects in the package and get unique types that |
|
| 35 |
# are available |
|
| 36 | ! |
data_type_names <- c("index", "agecomp", "lengthcomp")
|
| 37 | ! |
if (is.null(data_type)) {
|
| 38 | ! |
available_distributions <- c("lognormal", "gaussian")
|
| 39 |
} else {
|
|
| 40 | ! |
available_distributions <- switch( |
| 41 | ! |
EXPR = ifelse(grepl("comp", data_type), "composition", data_type),
|
| 42 | ! |
"index" = c("lognormal", "gaussian"),
|
| 43 | ! |
"composition" = c("multinomial"),
|
| 44 | ! |
"unavailable data type" |
| 45 |
) |
|
| 46 |
} |
|
| 47 | ! |
elements_of_sd <- c("value", "estimated")
|
| 48 | ||
| 49 |
# Start a bulleted list of errors and add to it in each if statement |
|
| 50 | ! |
abort_bullets <- c( |
| 51 | ! |
" " = "The following errors were found in the input argument {.var args}."
|
| 52 |
) |
|
| 53 | ! |
if (any(check_present)) {
|
| 54 | ! |
bad <- names(check_present[unlist(check_present)]) |
| 55 | ! |
abort_bullets <- c( |
| 56 | ! |
abort_bullets, |
| 57 | ! |
"x" = "{.var {bad}} {cli::qty(length(bad))} {?is/are} missing from
|
| 58 | ! |
{.var args}."
|
| 59 |
) |
|
| 60 |
# Abort early because not all of the necessary items were in args |
|
| 61 | ! |
cli::cli_abort(abort_bullets) |
| 62 |
} |
|
| 63 | ||
| 64 |
# Checks related to the family class |
|
| 65 | ! |
if (!inherits(family, "family")) {
|
| 66 | ! |
abort_bullets <- c( |
| 67 | ! |
abort_bullets, |
| 68 | ! |
"x" = "The class of {.var family} is incorrect.",
|
| 69 | ! |
"i" = "{.var family} should be an object of class {.var family},
|
| 70 | ! |
e.g., `family = gaussian()`, instead of {class(family)}."
|
| 71 |
) |
|
| 72 |
} |
|
| 73 |
if ( |
|
| 74 | ! |
!(family[["family"]] %in% available_distributions) || |
| 75 | ! |
"unavailable data type" %in% available_distributions |
| 76 |
) {
|
|
| 77 | ! |
ifelse_type <- ifelse( |
| 78 | ! |
is.null(data_type), |
| 79 | ! |
"distribution", |
| 80 | ! |
paste(data_type, "data") |
| 81 |
) |
|
| 82 | ! |
abort_bullets <- c( |
| 83 | ! |
abort_bullets, |
| 84 | ! |
"x" = "FIMS currently does not allow the family to be |
| 85 | ! |
{.code {family[['family']]}}.",
|
| 86 | ! |
"i" = "The families available for this {ifelse_type} are
|
| 87 | ! |
{.code {available_distributions}}."
|
| 88 |
) |
|
| 89 |
} |
|
| 90 | ||
| 91 |
# Checks related to the type of data |
|
| 92 | ! |
if (!is.null(data_type)) {
|
| 93 | ! |
if (!(data_type %in% data_type_names)) {
|
| 94 | ! |
abort_bullets <- c( |
| 95 | ! |
abort_bullets, |
| 96 | ! |
"x" = "The specified {.var data_type} of {.var {data_type}} is not
|
| 97 | ! |
available.", |
| 98 | ! |
"i" = "Allowed values for {.var data_type} are
|
| 99 | ! |
{.code {data_type_names}}."
|
| 100 |
) |
|
| 101 |
} |
|
| 102 |
} |
|
| 103 | ||
| 104 |
# Checks related to standard deviation |
|
| 105 |
# Check if sd has both elements and if yes, then go onto the else statement |
|
| 106 |
# for major checks |
|
| 107 | ! |
if (!all(elements_of_sd %in% names(sd))) {
|
| 108 | ! |
abort_bullets <- c( |
| 109 | ! |
abort_bullets, |
| 110 | ! |
"x" = "{.var {elements_of_sd}} need to be present in sd.",
|
| 111 | ! |
"i" = "Only {.code {names(sd)}} {cli::qty(length(sd))} {?is/are} present."
|
| 112 |
) |
|
| 113 |
} else {
|
|
| 114 | ! |
if (!all(sd[["value"]] > 0, na.rm = TRUE)) {
|
| 115 | ! |
abort_bullets <- c( |
| 116 | ! |
abort_bullets, |
| 117 | ! |
"x" = "Values passed to {.var sd} are out of bounds.",
|
| 118 | ! |
"i" = "Values passed to {.var sd} {cli::qty(length(sd[['value']]))}
|
| 119 | ! |
{?is/are} {.code {sd[['value']]}}.",
|
| 120 | ! |
"i" = "All standard deviation (sd) values need to be positive." |
| 121 |
) |
|
| 122 |
} |
|
| 123 |
if ( |
|
| 124 | ! |
length(sd[["estimated"]]) > 1 && |
| 125 | ! |
length(sd[["value"]]) != length(sd[["estimated"]]) |
| 126 |
) {
|
|
| 127 | ! |
sd_length <- length(sd[["value"]]) |
| 128 | ! |
est_length <- length(sd[["estimated"]]) |
| 129 | ! |
abort_bullets <- c( |
| 130 | ! |
abort_bullets, |
| 131 | ! |
"x" = "The sizes of {.var value} and {.var estimated} within {.var sd}
|
| 132 | ! |
must match if more than one value is specified for the latter.", |
| 133 | ! |
"i" = "The length of {.var sd[['value']]} is {.code {sd_length}}.",
|
| 134 | ! |
"i" = "The length of {.var sd[['estimated']]} is
|
| 135 | ! |
{.code {est_length}}."
|
| 136 |
) |
|
| 137 |
} |
|
| 138 |
} |
|
| 139 | ||
| 140 |
# Return error messages if more than just the default is present |
|
| 141 | ! |
if (length(abort_bullets) == 1) {
|
| 142 | ! |
invisible(TRUE) |
| 143 |
} else {
|
|
| 144 | ! |
cli::cli_abort(abort_bullets) |
| 145 |
} |
|
| 146 |
} |
|
| 147 | ||
| 148 |
#' Return name of expected value |
|
| 149 |
#' |
|
| 150 |
#' The combination of data type, family, and link lead to a specific name for |
|
| 151 |
#' the expected value within the code base. This function looks at the |
|
| 152 |
#' combination of these three objects and specifies the appropriate string for |
|
| 153 |
#' its name going forward. |
|
| 154 |
#' @inheritParams initialize_data_distribution |
|
| 155 |
#' @noRd |
|
| 156 |
#' @return |
|
| 157 |
#' A string specifying the name of the expected value. |
|
| 158 |
#' |
|
| 159 |
get_expected_name <- function(family, data_type) {
|
|
| 160 |
# TODO: Think about if the name of the expected value should change based on |
|
| 161 |
# the link or if it should stay the same? Keeping track of different names in |
|
| 162 |
# the code base might be too complex for the output as well |
|
| 163 | ! |
family_string <- family[["family"]] |
| 164 | ! |
link_string <- family[["link"]] |
| 165 | ! |
expected_name <- dplyr::case_when( |
| 166 | ! |
data_type == "index" && |
| 167 | ! |
grepl("lognormal|gaussian", family_string) &&
|
| 168 | ! |
link_string == "log" ~ "log_expected_index", |
| 169 | ! |
data_type == "index" && |
| 170 | ! |
grepl("lognormal|gaussian", family_string) &&
|
| 171 | ! |
link_string == "identity" ~ "expected_index", |
| 172 | ! |
grepl("agecomp", data_type) ~ "proportion_catch_numbers_at_age",
|
| 173 | ! |
grepl("lengthcomp", data_type) ~ "proportion_catch_numbers_at_length",
|
| 174 |
) |
|
| 175 |
# Check combination of entries was okay and led to valid name |
|
| 176 | ! |
if (is.na(expected_name)) {
|
| 177 | ! |
cli::cli_abort(c( |
| 178 | ! |
"x" = "The combination of data type, family, and link are incompatible in |
| 179 | ! |
some way.", |
| 180 | ! |
"i" = "{.var data_type} is {.var {data_type}}.",
|
| 181 | ! |
"i" = "The family is {.var {family_string}}.",
|
| 182 | ! |
"i" = "The link is {.var {link_string}}."
|
| 183 |
)) |
|
| 184 |
} |
|
| 185 | ! |
return(expected_name) |
| 186 |
} |
|
| 187 | ||
| 188 |
#' Set up a new distribution for a data type or a process |
|
| 189 |
#' |
|
| 190 |
#' Use [methods::new()] to set up a distribution within an existing module with |
|
| 191 |
#' the necessary linkages between the two. For example, a fleet module will need |
|
| 192 |
#' a distributional assumption for parts of the data associated with it, which |
|
| 193 |
#' requires the use of `initialize_data_distribution()`, and a recruitment |
|
| 194 |
#' module, like the Beverton--Holt stock--recruit relationship, will need a |
|
| 195 |
#' distribution associated with the recruitment deviations, which requires |
|
| 196 |
#' `initialize_process_distribution()`. |
|
| 197 |
#' @param module An identifier to a C++ fleet module that is linked to the data |
|
| 198 |
#' of interest. |
|
| 199 |
#' @param family A description of the error distribution and link function to |
|
| 200 |
#' be used in the model. The argument takes a family class, e.g., |
|
| 201 |
#' `stats::gaussian(link = "identity")`. |
|
| 202 |
#' @param sd A list of length two. The first entry is named `"value"` and it |
|
| 203 |
#' stores the initial values (scalar or vector) for the relevant standard |
|
| 204 |
#' deviations. The default is `value = 1`. The second entry is named |
|
| 205 |
#' `"estimated"` and it stores a vector of booleans (default = FALSE) is a |
|
| 206 |
#' scalar indicating whether or not standard deviation is estimated. If |
|
| 207 |
#' `"value"` is a vector and `"estimated"` is a scalar, the single value |
|
| 208 |
#' specified `"estimated"` value will be repeated to match the length of |
|
| 209 |
#' `value`. Otherwise, the dimensions of the two must match. |
|
| 210 |
#' @param data_type A string specifying the type of data that the |
|
| 211 |
#' distribution will be fit to. Allowable types include |
|
| 212 |
#' `r toString(formals(initialize_data_distribution)[["data_type"]])` |
|
| 213 |
#' and the default is |
|
| 214 |
#' `r toString(formals(initialize_data_distribution)[["data_type"]][1])`. |
|
| 215 |
#' @param par A string specifying the parameter name the distribution applies |
|
| 216 |
#' to. Parameters must be members of the specified module. Use |
|
| 217 |
#' `methods::show(module)` to obtain names of parameters within the module. |
|
| 218 |
#' @param is_random_effect A boolean indicating whether or not the process is |
|
| 219 |
#' estimated as a random effect. |
|
| 220 |
#' @return |
|
| 221 |
#' A reference class. is returned. Use [methods::show()] to view the various |
|
| 222 |
#' Rcpp class fields, methods, and documentation. |
|
| 223 |
#' @keywords distribution |
|
| 224 |
#' @export |
|
| 225 |
#' @examples |
|
| 226 |
#' \dontrun{
|
|
| 227 |
#' # Set up a new data distribution |
|
| 228 |
#' n_years <- 30 |
|
| 229 |
#' # Create a new fleet module |
|
| 230 |
#' fleet <- methods::new(Fleet) |
|
| 231 |
#' # Create a distribution for the fleet module |
|
| 232 |
#' fleet_distribution <- initialize_data_distribution( |
|
| 233 |
#' module = fishing_fleet, |
|
| 234 |
#' family = lognormal(link = "log"), |
|
| 235 |
#' sd = list( |
|
| 236 |
#' value = rep(sqrt(log(0.01^2 + 1)), n_years), |
|
| 237 |
#' estimated = rep(FALSE, n_years) # Could also be a single FALSE |
|
| 238 |
#' ), |
|
| 239 |
#' data_type = "index" |
|
| 240 |
#' ) |
|
| 241 |
#' |
|
| 242 |
#' # Set up a new process distribution |
|
| 243 |
#' # Create a new recruitment module |
|
| 244 |
#' recruitment <- methods::new(BevertonHoltRecruitment) |
|
| 245 |
#' # view parameter names of the recruitment module |
|
| 246 |
#' methods::show(BevertonHoltRecruitment) |
|
| 247 |
#' # Create a distribution for the recruitment module |
|
| 248 |
#' recruitment_distribution <- initialize_process_distribution( |
|
| 249 |
#' module = recruitment, |
|
| 250 |
#' par = "log_devs", |
|
| 251 |
#' family = gaussian(), |
|
| 252 |
#' sd = list(value = 0.4, estimated = FALSE), |
|
| 253 |
#' is_random_effect = FALSE |
|
| 254 |
#' ) |
|
| 255 |
#' } |
|
| 256 |
initialize_data_distribution <- function( |
|
| 257 |
module, |
|
| 258 |
family, |
|
| 259 |
sd = list(value = 1, estimated = FALSE), |
|
| 260 |
# FIXME: Move this argument to second to match where par is in |
|
| 261 |
# initialize_process_distribution |
|
| 262 |
data_type = c("index", "agecomp", "lengthcomp")
|
|
| 263 |
) {
|
|
| 264 | ! |
data_type <- rlang::arg_match(data_type) |
| 265 |
# FIXME: Make the available families a data object |
|
| 266 |
# Could also make the matrix of distributions available per type as a |
|
| 267 |
# data frame where the check could use the stored object. |
|
| 268 | ||
| 269 | ||
| 270 |
# validity check on user input |
|
| 271 | ! |
args <- list( |
| 272 | ! |
family = family, |
| 273 | ! |
sd = sd, |
| 274 | ! |
data_type = data_type |
| 275 |
) |
|
| 276 | ! |
check_distribution_validity(args) |
| 277 | ||
| 278 |
# assign name of observed data based on data_type |
|
| 279 | ! |
obs_id_name <- glue::glue("observed_{data_type}_data_id")
|
| 280 | ||
| 281 |
# Set up distribution based on `family` argument` |
|
| 282 | ! |
if (family[["family"]] == "lognormal") {
|
| 283 |
# create new Rcpp module |
|
| 284 | ! |
new_module <- methods::new(DlnormDistribution) |
| 285 | ||
| 286 |
# populate logged standard deviation parameter with log of input |
|
| 287 | ! |
new_module$log_sd <- methods::new( |
| 288 | ! |
ParameterVector, |
| 289 | ! |
log(sd[["value"]]), |
| 290 | ! |
length(sd[["value"]]) |
| 291 |
) |
|
| 292 |
# setup whether or not sd parameter is estimated |
|
| 293 | ! |
if (length(sd[["value"]]) > 1 && length(sd[["estimated"]]) == 1) {
|
| 294 | ! |
new_module$log_sd$set_all_estimable(sd[["estimated"]]) |
| 295 |
} else {
|
|
| 296 | ! |
for (i in 1:seq_along(sd[["estimated"]])) {
|
| 297 | ! |
new_module$log_sd[i]$estimated <- sd[["estimated"]][i] |
| 298 |
} |
|
| 299 |
} |
|
| 300 |
} |
|
| 301 | ||
| 302 | ! |
if (family[["family"]] == "gaussian") {
|
| 303 |
# create new Rcpp module |
|
| 304 | ! |
new_module <- methods::new(DnormDistribution) |
| 305 | ||
| 306 |
# populate logged standard deviation parameter with log of input |
|
| 307 | ! |
new_module$log_sd$resize(length(sd[["value"]])) |
| 308 | ! |
for (i in seq_along(sd[["value"]])) {
|
| 309 | ! |
new_module$log_sd[i]$value <- log(sd[["value"]][i]) |
| 310 |
} |
|
| 311 | ||
| 312 |
# setup whether or not sd parameter is estimated |
|
| 313 | ! |
if (length(sd[["value"]]) > 1 && length(sd[["estimated"]]) == 1) {
|
| 314 | ! |
new_module$log_sd$set_all_estimable(sd[["estimated"]]) |
| 315 |
} else {
|
|
| 316 | ! |
for (i in 1:seq_along(sd[["estimated"]])) {
|
| 317 | ! |
new_module$log_sd[i]$estimated <- sd[["estimated"]][i] |
| 318 |
} |
|
| 319 |
} |
|
| 320 |
} |
|
| 321 | ||
| 322 | ! |
if (family[["family"]] == "multinomial") {
|
| 323 |
# create new Rcpp module |
|
| 324 | ! |
new_module <- methods::new(DmultinomDistribution) |
| 325 |
} |
|
| 326 | ||
| 327 |
# setup link to observed data |
|
| 328 | ! |
if (data_type == "index") {
|
| 329 | ! |
new_module$set_observed_data(module$GetObservedIndexDataID()) |
| 330 |
} |
|
| 331 | ! |
if (data_type == "agecomp") {
|
| 332 | ! |
new_module$set_observed_data(module$GetObservedAgeCompDataID()) |
| 333 |
} |
|
| 334 | ! |
if (data_type == "lengthcomp") {
|
| 335 | ! |
new_module$set_observed_data(module$GetObservedLengthCompDataID()) |
| 336 |
} |
|
| 337 | ||
| 338 |
# set name of expected values |
|
| 339 | ! |
expected <- get_expected_name(family, data_type) |
| 340 |
# setup link to expected values |
|
| 341 | ! |
new_module$set_distribution_links("data", module$field(expected)$get_id())
|
| 342 | ||
| 343 | ! |
return(new_module) |
| 344 |
} |
|
| 345 | ||
| 346 |
#' @rdname initialize_data_distribution |
|
| 347 |
#' @keywords distribution |
|
| 348 |
#' @export |
|
| 349 |
initialize_process_distribution <- function( |
|
| 350 |
module, |
|
| 351 |
par, |
|
| 352 |
family, |
|
| 353 |
sd = list(value = 1, estimated = FALSE), |
|
| 354 |
is_random_effect = FALSE |
|
| 355 |
) {
|
|
| 356 |
# validity check on user input |
|
| 357 | ! |
args <- list(family = family, sd = sd) |
| 358 | ! |
check_distribution_validity(args) |
| 359 | ||
| 360 |
# Set up distribution based on `family` argument` |
|
| 361 | ! |
if (family[["family"]] == "lognormal") {
|
| 362 |
# create new Rcpp module |
|
| 363 | ! |
new_module <- methods::new(DlnormDistribution) |
| 364 | ||
| 365 |
# populate logged standard deviation parameter with log of input |
|
| 366 | ! |
new_module$log_sd <- methods::new( |
| 367 | ! |
ParameterVector, |
| 368 | ! |
log(sd[["value"]]), |
| 369 | ! |
length(sd[["value"]]) |
| 370 |
) |
|
| 371 |
# setup whether or not sd parameter is estimated |
|
| 372 | ! |
if (length(sd[["value"]]) > 1 && length(sd[["estimated"]]) == 1) {
|
| 373 | ! |
new_module$log_sd$set_all_estimable(sd[["estimated"]]) |
| 374 |
} else {
|
|
| 375 | ! |
for (i in 1:seq_along(sd[["estimated"]])) {
|
| 376 | ! |
new_module$log_sd[i]$estimated <- sd[["estimated"]][i] |
| 377 |
} |
|
| 378 |
} |
|
| 379 |
} |
|
| 380 | ||
| 381 | ! |
if (family[["family"]] == "gaussian") {
|
| 382 |
# create new Rcpp module |
|
| 383 | ! |
new_module <- methods::new(DnormDistribution) |
| 384 | ||
| 385 |
# populate logged standard deviation parameter with log of input |
|
| 386 | ! |
new_module$log_sd$resize(length(sd[["value"]])) |
| 387 | ! |
for (i in seq_along(sd[["value"]])) {
|
| 388 | ! |
new_module$log_sd[i]$value <- log(sd[["value"]][i]) |
| 389 |
} |
|
| 390 | ||
| 391 |
# setup whether or not sd parameter is estimated |
|
| 392 | ! |
if (length(sd[["value"]]) > 1 && length(sd[["estimated"]]) == 1) {
|
| 393 | ! |
new_module$log_sd$set_all_estimable(sd[["estimated"]]) |
| 394 |
} else {
|
|
| 395 | ! |
for (i in 1:seq_along(sd[["estimated"]])) {
|
| 396 | ! |
new_module$log_sd[i]$estimated <- sd[["estimated"]][i] |
| 397 |
} |
|
| 398 |
} |
|
| 399 |
} |
|
| 400 | ||
| 401 |
# indicate whether or not parameter is treated as a random effect in the model |
|
| 402 | ! |
module$field(par)$set_all_random(is_random_effect) |
| 403 | ||
| 404 | ! |
n_dim <- length(module$field(par)) |
| 405 | ||
| 406 |
# create new Rcpp modules |
|
| 407 | ! |
new_module$x$resize(n_dim) |
| 408 | ! |
new_module$expected_values$resize(n_dim) |
| 409 | ||
| 410 |
# initialize values with 0 |
|
| 411 |
# these are overwritten in the code later by user input |
|
| 412 | ! |
for (i in 1:n_dim) {
|
| 413 | ! |
new_module$x[i]$value <- 0 |
| 414 | ! |
new_module$expected_values[i]$value <- 0 |
| 415 |
} |
|
| 416 | ||
| 417 |
# setup links to parameter |
|
| 418 | ! |
new_module$set_distribution_links( |
| 419 | ! |
"random_effects", |
| 420 | ! |
module$field(par)$get_id() |
| 421 |
) |
|
| 422 | ||
| 423 | ! |
return(new_module) |
| 424 |
} |
|
| 425 | ||
| 426 |
#' Distributions not available in the stats package |
|
| 427 |
#' |
|
| 428 |
#' Family objects provide a convenient way to specify the details of the models |
|
| 429 |
#' used by functions such as [stats::glm()]. These functions within this |
|
| 430 |
#' package are not available within the stats package but are designed in a |
|
| 431 |
#' similar manner. |
|
| 432 |
#' |
|
| 433 |
#' @param link A string specifying the model link function. For example, |
|
| 434 |
#' `"identity"` or `"log"` are appropriate names for the [stats::gaussian()] |
|
| 435 |
#' distribution. `"log"` and `"logit"` are the defaults for the lognormal and |
|
| 436 |
#' the multinomial, respectively. |
|
| 437 |
#' @return |
|
| 438 |
#' An object of class `family` (which has a concise print method). This |
|
| 439 |
#' particular family has a truncated length compared to other distributions in |
|
| 440 |
#' [stats::family()]. |
|
| 441 |
#' \item{family}{character: the family name.}
|
|
| 442 |
#' \item{link}{character: the link name.}
|
|
| 443 |
#' |
|
| 444 |
#' @seealso |
|
| 445 |
#' * [stats::family()] |
|
| 446 |
#' * [stats::gaussian()] |
|
| 447 |
#' * [stats::glm()] |
|
| 448 |
#' * [stats::power()] |
|
| 449 |
#' * [stats::make.link()] |
|
| 450 |
#' @keywords distribution |
|
| 451 |
#' @export |
|
| 452 |
#' @examples |
|
| 453 |
#' a_family <- multinomial() |
|
| 454 |
#' a_family[["family"]] |
|
| 455 |
#' a_family[["link"]] |
|
| 456 |
lognormal <- function(link = "log") {
|
|
| 457 | ! |
family_class <- c( |
| 458 | ! |
list(family = "lognormal", link = link), |
| 459 | ! |
stats::make.link(link) |
| 460 |
) |
|
| 461 | ! |
class(family_class) <- "family" |
| 462 | ! |
return(family_class) |
| 463 |
} |
|
| 464 | ||
| 465 |
#' @rdname lognormal |
|
| 466 |
#' @keywords distribution |
|
| 467 |
#' @export |
|
| 468 |
multinomial <- function(link = "logit") {
|
|
| 469 | ! |
family_class <- c( |
| 470 | ! |
list(family = "multinomial", link = link), |
| 471 | ! |
stats::make.link(link) |
| 472 |
) |
|
| 473 | ! |
class(family_class) <- "family" |
| 474 | ! |
return(family_class) |
| 475 |
} |
| 1 |
Rcpp::loadModule(module = "fims", what = TRUE) |
|
| 2 | ||
| 3 |
.onUnload <- function(libpath) {
|
|
| 4 | ! |
library.dynam.unload("FIMS", libpath)
|
| 5 |
} |
|
| 6 | ||
| 7 |
# Methods for Rcpp |
|
| 8 |
#' Setter for `Rcpp_ParameterVector` |
|
| 9 |
#' |
|
| 10 |
#' In R, indexing starts at one. But, in C++ indexing starts at zero. These |
|
| 11 |
#' functions do the translation for you so you can think in R terms. |
|
| 12 |
#' |
|
| 13 |
#' @param x A numeric vector. |
|
| 14 |
#' @param i An integer specifying the location in R speak, where indexing |
|
| 15 |
#' starts at one, of the vector that you wish to set. |
|
| 16 |
#' @param j Not used with `Rcpp_ParameterVector` because it is a vector. |
|
| 17 |
#' @param value The value you want to set the indexed location to. |
|
| 18 |
#' @return |
|
| 19 |
#' For `[<-`, the index `i` of object `x` is set to `value`. |
|
| 20 |
#' @keywords set_methods |
|
| 21 |
#' @rdname Rcpp_ParameterVector |
|
| 22 |
methods::setMethod( |
|
| 23 |
f = "[<-", |
|
| 24 |
signature = signature( |
|
| 25 |
x = "Rcpp_ParameterVector" |
|
| 26 |
), |
|
| 27 |
definition = function(x, i, j, value) {
|
|
| 28 | ! |
x$set(i - 1, value) # R uses 1-based indexing, C++ uses 0-based indexing |
| 29 | ! |
return(x) # Return the modified object |
| 30 |
} |
|
| 31 |
) |
|
| 32 | ||
| 33 |
#' Get information from Rcpp_ParameterVector |
|
| 34 |
#' |
|
| 35 |
#' In R, indexing starts at one. But, in C++ indexing starts at zero. This |
|
| 36 |
#' function does the translation for you so you can think in R terms. |
|
| 37 |
#' |
|
| 38 |
#' @param x A numeric vector. |
|
| 39 |
#' @param i An integer specifying the location in R speak, where indexing |
|
| 40 |
#' starts at one, of the vector that you wish to get information from. |
|
| 41 |
#' @return |
|
| 42 |
#' For `[`, the index `i` of object `x` is returned. |
|
| 43 |
#' @keywords set_methods |
|
| 44 |
#' @rdname Rcpp_ParameterVector |
|
| 45 |
methods::setMethod( |
|
| 46 |
f = "[", |
|
| 47 |
signature = signature(x = "Rcpp_ParameterVector", i = "numeric"), |
|
| 48 |
definition = function(x, i) {
|
|
| 49 | ! |
return(x$get(i - 1)) |
| 50 |
} |
|
| 51 |
) |
|
| 52 | ||
| 53 |
#' Get the length of an Rcpp_ParameterVector |
|
| 54 |
#' |
|
| 55 |
#' @param x A numeric vector. |
|
| 56 |
#' @return |
|
| 57 |
#' For `length()`, the length of object `x` is returned as an integer. |
|
| 58 |
#' @keywords set_methods |
|
| 59 |
#' @rdname Rcpp_ParameterVector |
|
| 60 |
methods::setMethod( |
|
| 61 |
f = "length", |
|
| 62 |
signature = signature(x = "Rcpp_ParameterVector"), |
|
| 63 |
definition = function(x) {
|
|
| 64 | ! |
return(x$size()) |
| 65 |
} |
|
| 66 |
) |
|
| 67 | ||
| 68 |
#' Get the sum of all entries in an Rcpp_ParameterVector |
|
| 69 |
#' |
|
| 70 |
#' @param x A numeric vector. |
|
| 71 |
#' @return |
|
| 72 |
#' For `sum()`, the sum of object `x` is returned as a numeric value. |
|
| 73 |
#' @keywords set_methods |
|
| 74 |
#' @rdname Rcpp_ParameterVector |
|
| 75 |
methods::setMethod( |
|
| 76 |
f = "sum", |
|
| 77 |
signature = signature(x = "Rcpp_ParameterVector"), |
|
| 78 |
definition = function(x) {
|
|
| 79 | ! |
ret <- methods::new(Parameter) |
| 80 | ! |
tmp <- 0.0 |
| 81 | ! |
for (i in 1:x$size()) {
|
| 82 | ! |
tmp <- tmp + x[i]$value |
| 83 |
} |
|
| 84 | ! |
ret$value <- tmp |
| 85 | ! |
return(ret) |
| 86 |
} |
|
| 87 |
) |
|
| 88 | ||
| 89 |
#' Get the dimensions of an Rcpp_ParameterVector |
|
| 90 |
#' |
|
| 91 |
#' @param x A numeric vector. |
|
| 92 |
#' @return |
|
| 93 |
#' For `dim()`, the dimensions of object `x` is returned as a single integer |
|
| 94 |
#' because there is only one dimension to return for a vector. |
|
| 95 |
#' @keywords set_methods |
|
| 96 |
#' @rdname Rcpp_ParameterVector |
|
| 97 |
methods::setMethod( |
|
| 98 |
f = "dim", |
|
| 99 |
signature = signature(x = "Rcpp_ParameterVector"), |
|
| 100 |
definition = function(x) {
|
|
| 101 | ! |
return(x$size()) |
| 102 |
} |
|
| 103 |
) |
|
| 104 | ||
| 105 |
#' Sets methods for operators under the S4 Generic Group, Ops |
|
| 106 |
#' |
|
| 107 |
#' Ops include Arith (`+`, `-`, `*`, `^`, `%%`, `%/%`, and `/`); |
|
| 108 |
#' Compare (`==`, `>`, `<`, `!=`, `<=`, and `>=`); and |
|
| 109 |
#' Logic (`&`, `|`). |
|
| 110 |
#' |
|
| 111 |
#' @param e1,e2 An Rcpp_Parameter or Rcpp_ParameterVector class object or a |
|
| 112 |
#' numeric vector or value. |
|
| 113 |
#' @return |
|
| 114 |
#' A numeric or logical value(s) depending on the generic and the length of |
|
| 115 |
#' the input values. |
|
| 116 |
#' @keywords set_methods |
|
| 117 |
#' @export |
|
| 118 |
#' @rdname Rcpp_Math |
|
| 119 |
methods::setMethod( |
|
| 120 |
"Ops", |
|
| 121 |
signature(e1 = "Rcpp_Parameter", e2 = "Rcpp_Parameter"), |
|
| 122 |
function(e1, e2) {
|
|
| 123 | ! |
ret <- methods::new(Parameter) |
| 124 | ! |
ret$value <- methods::callGeneric(e1$value, e2$value) |
| 125 |
} |
|
| 126 |
) |
|
| 127 | ||
| 128 |
#' @rdname Rcpp_Math |
|
| 129 |
methods::setMethod( |
|
| 130 |
"Ops", |
|
| 131 |
signature(e1 = "Rcpp_Parameter", e2 = "numeric"), |
|
| 132 |
function(e1, e2) {
|
|
| 133 | ! |
if (length(e2) != 1) {
|
| 134 | ! |
stop("Call to operator Ops, value not scalar")
|
| 135 |
} |
|
| 136 | ! |
ret <- methods::new(Parameter) |
| 137 | ! |
ret$value <- methods::callGeneric(e1$value, e2) |
| 138 |
} |
|
| 139 |
) |
|
| 140 | ||
| 141 |
#' @rdname Rcpp_Math |
|
| 142 |
methods::setMethod( |
|
| 143 |
"Ops", signature(e1 = "numeric", e2 = "Rcpp_Parameter"), |
|
| 144 |
function(e1, e2) {
|
|
| 145 | ! |
if (length(e1) != 1) {
|
| 146 | ! |
stop("Call to operator Ops, value not scalar")
|
| 147 |
} |
|
| 148 | ! |
ret <- methods::new(Parameter) |
| 149 | ! |
ret$value <- methods::callGeneric(e1, e2$value) |
| 150 |
} |
|
| 151 |
) |
|
| 152 | ||
| 153 |
#' @rdname Rcpp_Math |
|
| 154 |
methods::setMethod( |
|
| 155 |
"Ops", |
|
| 156 |
signature(e1 = "Rcpp_ParameterVector", e2 = "Rcpp_ParameterVector"), |
|
| 157 |
function(e1, e2) {
|
|
| 158 | ! |
if (e1$size() != e2$size()) {
|
| 159 | ! |
stop("Call to operator Ops, vectors not equal length")
|
| 160 |
} |
|
| 161 | ! |
ret <- methods::new(ParameterVector, e1$size()) |
| 162 | ! |
for (i in 1:e1$size()) {
|
| 163 | ! |
ret[i]$value <- methods::callGeneric(e1[i]$value, e2[i]$value) |
| 164 |
} |
|
| 165 | ! |
return(ret) |
| 166 |
} |
|
| 167 |
) |
|
| 168 | ||
| 169 |
#' @rdname Rcpp_Math |
|
| 170 |
methods::setMethod( |
|
| 171 |
"Ops", |
|
| 172 |
signature(e1 = "Rcpp_ParameterVector", e2 = "numeric"), |
|
| 173 |
function(e1, e2) {
|
|
| 174 | ! |
if (e1$size() != length(e2)) {
|
| 175 | ! |
if (length(e2) == 1) {
|
| 176 | ! |
ret <- methods::new(ParameterVector, e1$size()) |
| 177 | ! |
for (i in 1:e1$size()) {
|
| 178 | ! |
ret[i]$value <- methods::callGeneric(e1[i]$value, e2) |
| 179 |
} |
|
| 180 | ! |
return(ret) |
| 181 |
} |
|
| 182 | ! |
stop("Call to Ops, vectors not equal length")
|
| 183 |
} |
|
| 184 | ! |
ret <- methods::new(ParameterVector, e1$size()) |
| 185 | ! |
for (i in 1:e1$size()) {
|
| 186 | ! |
ret[i]$value <- methods::callGeneric(e1[i]$value, e2[i]) |
| 187 |
} |
|
| 188 | ! |
return(ret) |
| 189 |
} |
|
| 190 |
) |
|
| 191 | ||
| 192 |
#' @rdname Rcpp_Math |
|
| 193 |
methods::setMethod( |
|
| 194 |
"Ops", |
|
| 195 |
signature(e1 = "numeric", e2 = "Rcpp_ParameterVector"), |
|
| 196 |
function(e1, e2) {
|
|
| 197 | ! |
if (length(e1) != e2$size()) {
|
| 198 | ! |
if (length(e1) == 1) {
|
| 199 | ! |
ret <- methods::new(ParameterVector, e2$size()) |
| 200 | ! |
for (i in 1:e2$size()) {
|
| 201 | ! |
ret[i]$value <- methods::callGeneric(e1, e2[i]$value) |
| 202 |
} |
|
| 203 | ! |
return(ret) |
| 204 |
} |
|
| 205 | ! |
stop("Call to operator, vectors not equal length")
|
| 206 |
} |
|
| 207 | ! |
ret <- methods::new(ParameterVector, e2$size()) |
| 208 | ! |
for (i in 1:e2$size()) {
|
| 209 | ! |
ret[i]$value <- methods::callGeneric(e1[i], e2[i]$value) |
| 210 |
} |
|
| 211 | ! |
return(ret) |
| 212 |
} |
|
| 213 |
) |
|
| 214 | ||
| 215 |
#' Sets methods for math functions for Rcpp_ParameterVector |
|
| 216 |
#' |
|
| 217 |
#' Methods of mathematical functions include trigonometry functions, `abs`, |
|
| 218 |
#' `sign`, `sqrt`, `ceiling`, `floor`, `trunc`, `cummax`, `cumprod`, `cumsum`, |
|
| 219 |
#' `log`, `log10`, `log2`, `log1p`, `exp`, `expm1`, `gamma`, `lgamma`, |
|
| 220 |
#' `digamma`, and `trigamma`. |
|
| 221 |
#' |
|
| 222 |
#' @param x An Rcpp_ParameterVector class object. |
|
| 223 |
#' @return |
|
| 224 |
#' A vector of numeric values. |
|
| 225 |
#' @keywords set_methods |
|
| 226 |
#' @export |
|
| 227 |
#' @rdname Rcpp_Math |
|
| 228 |
methods::setMethod( |
|
| 229 |
"Math", |
|
| 230 |
signature(x = "Rcpp_ParameterVector"), |
|
| 231 |
function(x) {
|
|
| 232 | ! |
xx <- methods::new(ParameterVector, x$size()) |
| 233 | ! |
for (i in 1:x$size()) {
|
| 234 | ! |
xx[i]$value <- methods::callGeneric(x[i]$value) |
| 235 |
} |
|
| 236 | ! |
return(xx) |
| 237 |
} |
|
| 238 |
) |
|
| 239 | ||
| 240 |
#' Set methods for summary functions with an Rcpp_ParameterVector |
|
| 241 |
#' |
|
| 242 |
#' Methods of summary functions include `max`, `min`, `range`, `prod`, `sum`, |
|
| 243 |
#' `any`, and `all`. |
|
| 244 |
#' |
|
| 245 |
#' @param x An Rcpp_ParameterVector class object. |
|
| 246 |
#' @return |
|
| 247 |
#' `Summary` returns a single or two numeric or logical values. |
|
| 248 |
#' @export |
|
| 249 |
#' @keywords set_methods |
|
| 250 |
#' @rdname Rcpp_ParameterVector |
|
| 251 |
methods::setMethod( |
|
| 252 |
"Summary", |
|
| 253 |
signature(x = "Rcpp_ParameterVector"), |
|
| 254 |
function(x) {
|
|
| 255 | ! |
xx <- methods::new(ParameterVector, x$size()) |
| 256 | ! |
for (i in 1:x$size()) {
|
| 257 | ! |
xx[i]$value <- methods::callGeneric(x[i]$value) |
| 258 |
} |
|
| 259 | ! |
return(xx) |
| 260 |
} |
|
| 261 |
) |
| 1 |
# To remove the WARNING |
|
| 2 |
# no visible binding for global variable |
|
| 3 |
utils::globalVariables(c( |
|
| 4 |
"type", "name", "value", "unit", "uncertainty", |
|
| 5 |
"datestart", "dateend", "age", "length", "year" |
|
| 6 |
)) |
|
| 7 | ||
| 8 |
#' Initialize a generic module |
|
| 9 |
#' |
|
| 10 |
#' @description |
|
| 11 |
#' Initializes a generic module by setting up its fields based on the provided |
|
| 12 |
#' `module_name`. |
|
| 13 |
#' @param parameters A list. Contains parameters and modules required for |
|
| 14 |
#' initialization. |
|
| 15 |
#' @param data An S4 object. FIMS input data. |
|
| 16 |
#' @param module_name A character. Name of the module to initialize (e.g., |
|
| 17 |
#' "population" or "fleet"). |
|
| 18 |
#' @return |
|
| 19 |
#' The initialized module as an object. |
|
| 20 |
#' @noRd |
|
| 21 |
initialize_module <- function(parameters, data, module_name) {
|
|
| 22 |
# TODO: how to return all modules between pipes and create links between |
|
| 23 |
# modules? |
|
| 24 |
# # Retrieve all objects in the environment |
|
| 25 |
# objs <- mget(ls()) |
|
| 26 |
# modules <- get_rcpp_modules(objs) |
|
| 27 | ||
| 28 |
# Input checks |
|
| 29 |
# Check if parameters is a list and contains the necessary sub-elements |
|
| 30 | ! |
if (!is.list(parameters)) {
|
| 31 | ! |
cli::cli_abort("The {.var parameters} argument should be a list.")
|
| 32 | ! |
} else if (!all(c("parameters", "modules") %in% names(parameters))) {
|
| 33 | ! |
cli::cli_abort(c( |
| 34 | ! |
"The {.var parameters} argument must contain both parameters and modules
|
| 35 | ! |
lists." |
| 36 |
)) |
|
| 37 |
} |
|
| 38 |
# Validate module_name |
|
| 39 | ! |
if (!is.character(module_name) || length(module_name) != 1) {
|
| 40 | ! |
cli::cli_abort("{.var module_name} must be a single character string.")
|
| 41 |
} |
|
| 42 | ||
| 43 |
# Check if module_name exists in the parameters list |
|
| 44 | ! |
if (!module_name %in% c( |
| 45 | ! |
names(parameters[["parameters"]]), |
| 46 | ! |
names(parameters[["modules"]]) |
| 47 |
)) {
|
|
| 48 | ! |
cli::cli_abort("{.var module_name} is missing from the {.var parameters}.")
|
| 49 |
} |
|
| 50 | ||
| 51 |
# Define module class and fields |
|
| 52 | ! |
module_class_name <- if (module_name == "population") {
|
| 53 | ! |
"Population" |
| 54 | ! |
} else if (!(module_name %in% names(parameters[["modules"]])) && |
| 55 | ! |
(names(module_name) == "selectivity") |
| 56 |
) {
|
|
| 57 | ! |
parameters[["modules"]][["fleets"]][[ |
| 58 | ! |
module_name |
| 59 | ! |
]][[names(module_name)]][["form"]] |
| 60 | ! |
} else if (!(module_name %in% names(parameters[["modules"]])) && |
| 61 | ! |
names(module_name) == "Fleet" |
| 62 |
) {
|
|
| 63 | ! |
"Fleet" |
| 64 |
} else {
|
|
| 65 | ! |
parameters[["modules"]][[module_name]][["form"]] |
| 66 |
} |
|
| 67 | ||
| 68 | ! |
module_class <- get(module_class_name) |
| 69 | ! |
module_fields <- names(module_class@fields) |
| 70 | ! |
module <- methods::new(module_class) |
| 71 | ! |
module_input <- parameters[["parameters"]][[module_name]] |
| 72 | ||
| 73 | ! |
if (module_class_name == "Fleet") {
|
| 74 | ! |
module_fields <- setdiff(module_fields, c( |
| 75 | ! |
"log_expected_index", |
| 76 | ! |
"proportion_catch_numbers_at_age" |
| 77 |
)) |
|
| 78 | ||
| 79 | ! |
fleet_types <- get_data(data) |> |
| 80 | ! |
dplyr::filter(name == module_name) |> |
| 81 | ! |
dplyr::pull(type) |> |
| 82 | ! |
unique() |
| 83 | ||
| 84 | ! |
if ("landings" %in% fleet_types) {
|
| 85 | ! |
module_fields <- setdiff(module_fields, c( |
| 86 | ! |
"log_q", |
| 87 | ! |
"random_q", |
| 88 | ! |
"estimate_q" |
| 89 |
)) |
|
| 90 |
} else {
|
|
| 91 | ! |
module_fields <- setdiff(module_fields, c( |
| 92 | ! |
"log_Fmort" |
| 93 |
)) |
|
| 94 |
} |
|
| 95 | ||
| 96 |
# TODO: refactor "age-to-length-conversion" in FIMSFrame data and |
|
| 97 |
# "age_length_conversion_matrix" in the Rcpp interface to |
|
| 98 |
# "age_to_legnth_conversion" for consistency |
|
| 99 | ! |
data_distribution_names_for_fleet_i <- names(parameters[["modules"]][["fleets"]][[module_name]][["data_distribution"]]) |
| 100 | ! |
if ("age-to-length-conversion" %in% fleet_types &&
|
| 101 | ! |
"LengthComp" %in% data_distribution_names_for_fleet_i) {
|
| 102 | ! |
age_length_conversion_matrix_value <- FIMS::m_age_to_length_conversion(data, module_name) |
| 103 | ! |
module[["age_length_conversion_matrix"]]$resize(length(age_length_conversion_matrix_value)) |
| 104 |
# Assign each value to the corresponding position in the parameter vector |
|
| 105 | ! |
for (i in seq_along(age_length_conversion_matrix_value)) {
|
| 106 | ! |
module[["age_length_conversion_matrix"]][i][["value"]] <- age_length_conversion_matrix_value[i] |
| 107 |
} |
|
| 108 | ||
| 109 |
# Set the estimation information for the entire parameter vector |
|
| 110 | ! |
module[["age_length_conversion_matrix"]]$set_all_estimable(FALSE) |
| 111 | ||
| 112 | ! |
module[["age_length_conversion_matrix"]]$set_all_random(FALSE) |
| 113 |
} else {
|
|
| 114 | ! |
module_fields <- setdiff(module_fields, c( |
| 115 |
# Right now we can also remove nlengths because the default is 0 |
|
| 116 | ! |
"nlengths" |
| 117 |
)) |
|
| 118 |
} |
|
| 119 | ||
| 120 | ! |
module_fields <- setdiff(module_fields, c( |
| 121 | ! |
"age_length_conversion_matrix", |
| 122 | ! |
"proportion_catch_numbers_at_length" |
| 123 |
)) |
|
| 124 |
} |
|
| 125 | ||
| 126 |
# Populate fields based on common and specific settings |
|
| 127 |
# TODO: |
|
| 128 |
# - Population interface |
|
| 129 |
# - Update the Population interface to consistently use n_ages and n_years, |
|
| 130 |
# as done in the S4 data1 object. |
|
| 131 |
# - Currently hard-coded `nseason` to 1 using the defaults from FIMS. |
|
| 132 |
# Update as needed. |
|
| 133 |
# - Add n_fleets to data1. Should n_fleets include both |
|
| 134 |
# fishing and survey fleets? Currently, data1@fleets equals 1. |
|
| 135 |
# - Recruitment interface |
|
| 136 |
# - Remove the field estimate_log_devs. It will be set up using the |
|
| 137 |
# set_all_estimable() method instead. |
|
| 138 |
# - Fleet |
|
| 139 |
# - Remove estimate_Fmort, estimate_q, and random_q from the Rcpp interface |
|
| 140 |
# - Reconsider exposing `log_expected_index` and |
|
| 141 |
# `proportion_catch_numbers_at_age` to users. Their IDs are linked with |
|
| 142 |
# index and agecomp distributions. No input values are required. |
|
| 143 | ||
| 144 | ! |
non_standard_field <- c( |
| 145 | ! |
"ages", "nages", "nlengths", |
| 146 | ! |
"estimate_prop_female", |
| 147 | ! |
"nyears", "nseasons", "nfleets", "estimate_log_devs", "weights", |
| 148 | ! |
"is_survey", "estimate_q", "random_q" |
| 149 |
) |
|
| 150 | ! |
for (field in module_fields) {
|
| 151 | ! |
if (field %in% non_standard_field) {
|
| 152 |
# TODO: reorder the list alphabetically |
|
| 153 | ! |
module[[field]] <- switch(field, |
| 154 | ! |
"ages" = get_ages(data), |
| 155 | ! |
"nages" = get_n_ages(data), |
| 156 | ! |
"nlengths" = get_n_lengths(data), |
| 157 | ! |
"estimate_prop_female" = TRUE, |
| 158 | ! |
"nyears" = get_n_years(data), |
| 159 | ! |
"nseasons" = 1, |
| 160 | ! |
"nfleets" = length(parameters[["modules"]][["fleets"]]), |
| 161 | ! |
"estimate_log_devs" = module_input[[ |
| 162 | ! |
paste0(module_class_name, ".estimate_log_devs") |
| 163 |
]], |
|
| 164 | ! |
"weights" = m_weight_at_age(data), |
| 165 | ! |
"is_survey" = !("landings" %in% fleet_types),
|
| 166 | ! |
"estimate_q" = module_input[[ |
| 167 | ! |
paste0(module_class_name, ".log_q.estimated") |
| 168 |
]], |
|
| 169 | ! |
"random_q" = FALSE, |
| 170 | ! |
cli::cli_abort(c( |
| 171 | ! |
"{.var {field}} is not a valid field in {.var {module_class_name}}
|
| 172 | ! |
module." |
| 173 |
)) |
|
| 174 |
) |
|
| 175 |
} else {
|
|
| 176 | ! |
set_param_vector( |
| 177 | ! |
field = field, |
| 178 | ! |
module = module, |
| 179 | ! |
module_input = module_input |
| 180 |
) |
|
| 181 |
} |
|
| 182 |
} |
|
| 183 | ||
| 184 | ! |
return(module) |
| 185 |
} |
|
| 186 | ||
| 187 |
# TODO: Determine the relationship between distributions and the |
|
| 188 |
# recruitment module, and implement the appropriate logic to retrieve |
|
| 189 |
# distribution information. |
|
| 190 | ||
| 191 |
#' Initialize a distribution module |
|
| 192 |
#' |
|
| 193 |
#' @description |
|
| 194 |
#' Initializes a distribution module by setting up its fields based on the |
|
| 195 |
#' distribution name and type. Supports both "data" and "process" types. |
|
| 196 |
#' @param module_input A list. Contains parameters for initializing the |
|
| 197 |
#' distribution. |
|
| 198 |
#' @param distribution_name A character. Name of the distribution to initialize. |
|
| 199 |
#' @param distribution_type A character. Type of distribution, either "data" or |
|
| 200 |
#' "process". |
|
| 201 |
#' @param linked_ids A vector. Named vector of linked IDs required for the |
|
| 202 |
#' distribution, such as data_link and fleet_link for setting up index |
|
| 203 |
#' distribution. |
|
| 204 |
#' @rdname initialize_module |
|
| 205 |
#' @return |
|
| 206 |
#' The initialized distribution module as an object. |
|
| 207 |
#' @noRd |
|
| 208 |
initialize_distribution <- function( |
|
| 209 |
module_input, |
|
| 210 |
distribution_name, |
|
| 211 |
distribution_type = c("data", "process"),
|
|
| 212 |
linked_ids |
|
| 213 |
) {
|
|
| 214 |
# Input checks |
|
| 215 |
# Check if distribution_name is provided |
|
| 216 | ! |
if (is.null(distribution_name)) {
|
| 217 | ! |
return(NULL) |
| 218 |
} |
|
| 219 |
# Validate module_input |
|
| 220 | ! |
if (!is.list(module_input)) {
|
| 221 | ! |
cli::cli_abort("{.var module_input} must be a list.")
|
| 222 |
} |
|
| 223 |
# Validate distribution_type as "data" or "process" |
|
| 224 | ! |
distribution_type <- rlang::arg_match(distribution_type) |
| 225 |
# Validate linked_ids as a named vector with required elements for "data" type |
|
| 226 | ! |
if (!is.vector(linked_ids) || |
| 227 | ! |
!all(c("data_link", "fleet_link") %in% names(linked_ids))
|
| 228 |
) {
|
|
| 229 | ! |
cli::cli_abort( |
| 230 | ! |
"{.var linked_ids} must be a named vector containing 'data_link' and
|
| 231 | ! |
'fleet_link' for 'data' distribution types." |
| 232 |
) |
|
| 233 |
} |
|
| 234 | ||
| 235 |
# Get distribution value and initialize the module |
|
| 236 | ! |
distribution_value <- get(distribution_name) |
| 237 | ! |
distribution_module <- methods::new(distribution_value) |
| 238 | ! |
distribution_fields <- names(distribution_value@fields) |
| 239 | ! |
if (distribution_type == "data") {
|
| 240 | ! |
distribution_fields <- setdiff( |
| 241 | ! |
distribution_fields, |
| 242 | ! |
c("expected_values", "x", "dims")
|
| 243 |
) |
|
| 244 |
} |
|
| 245 | ||
| 246 | ! |
distribution_input_names <- grep( |
| 247 | ! |
distribution_name, |
| 248 | ! |
names(module_input), |
| 249 | ! |
value = TRUE |
| 250 |
) |
|
| 251 | ! |
for (field in distribution_fields) {
|
| 252 | ! |
set_param_vector( |
| 253 | ! |
field = field, module = distribution_module, |
| 254 | ! |
module_input = module_input[distribution_input_names] |
| 255 |
) |
|
| 256 |
} |
|
| 257 | ||
| 258 | ! |
switch(distribution_type, |
| 259 |
"data" = {
|
|
| 260 |
# Data distribution initialization |
|
| 261 | ! |
distribution_module$set_observed_data(linked_ids["data_link"]) |
| 262 | ! |
distribution_module$set_distribution_links( |
| 263 | ! |
distribution_type, |
| 264 | ! |
linked_ids["fleet_link"] |
| 265 |
) |
|
| 266 |
}, |
|
| 267 |
"process" = {
|
|
| 268 |
# Process distribution initialization |
|
| 269 | ! |
distribution_module$set_distribution_links("random_effects", linked_ids)
|
| 270 |
} |
|
| 271 |
) |
|
| 272 | ||
| 273 |
# Final message to confirm success |
|
| 274 | ! |
cli::cli_inform(c( |
| 275 | ! |
"i" = "{distribution_name} initialized successfully for
|
| 276 | ! |
{names(distribution_name)}."
|
| 277 |
)) |
|
| 278 | ||
| 279 | ! |
return(distribution_module) |
| 280 |
} |
|
| 281 | ||
| 282 |
#' Initialize a recruitment module |
|
| 283 |
#' |
|
| 284 |
#' @description |
|
| 285 |
#' Initializes a recruitment module by setting up fields. This function uses |
|
| 286 |
#' the `initialize_module` function to handle specific requirements for |
|
| 287 |
#' recruitment initialization. |
|
| 288 |
#' @inheritParams initialize_module |
|
| 289 |
#' @return |
|
| 290 |
#' The initialized recruitment module as an object. |
|
| 291 |
#' @noRd |
|
| 292 |
initialize_recruitment <- function(parameters, data) {
|
|
| 293 | ! |
module <- initialize_module( |
| 294 | ! |
parameters = parameters, |
| 295 | ! |
data = data, |
| 296 | ! |
module_name = setNames("recruitment", "population")
|
| 297 |
) |
|
| 298 | ! |
return(module) |
| 299 |
} |
|
| 300 | ||
| 301 |
#' Initialize a growth module |
|
| 302 |
#' |
|
| 303 |
#' @description |
|
| 304 |
#' Initializes a growth module by setting up fields. This function uses |
|
| 305 |
#' the `initialize_module` function to handle specific requirements for |
|
| 306 |
#' growth initialization. |
|
| 307 |
#' @inheritParams initialize_module |
|
| 308 |
#' @return |
|
| 309 |
#' The initialized growth module as an object. |
|
| 310 |
#' @noRd |
|
| 311 |
initialize_growth <- function(parameters, data) {
|
|
| 312 | ! |
module <- initialize_module( |
| 313 | ! |
parameters = parameters, |
| 314 | ! |
data = data, |
| 315 | ! |
module_name = setNames("growth", "population")
|
| 316 |
) |
|
| 317 | ! |
return(module) |
| 318 |
} |
|
| 319 | ||
| 320 |
#' Initialize a maturity module |
|
| 321 |
#' |
|
| 322 |
#' @description |
|
| 323 |
#' Initializes a maturity module by setting up fields. This function uses |
|
| 324 |
#' the `initialize_module` function to handle specific requirements for |
|
| 325 |
#' maturity initialization. |
|
| 326 |
#' @inheritParams initialize_module |
|
| 327 |
#' @return |
|
| 328 |
#' The initialized maturity module as an object. |
|
| 329 |
#' @noRd |
|
| 330 |
initialize_maturity <- function(parameters, data) {
|
|
| 331 | ! |
module <- initialize_module( |
| 332 | ! |
parameters = parameters, |
| 333 | ! |
data = data, |
| 334 | ! |
module_name = setNames("maturity", "population")
|
| 335 |
) |
|
| 336 | ! |
return(module) |
| 337 |
} |
|
| 338 | ||
| 339 |
#' Initialize a population module. |
|
| 340 |
#' |
|
| 341 |
#' @description |
|
| 342 |
#' Initializes a population module by setting up fields. This function uses |
|
| 343 |
#' the `initialize_module` function to handle specific requirements for |
|
| 344 |
#' population initialization. |
|
| 345 |
#' @inheritParams initialize_module |
|
| 346 |
#' @param linked_ids A vector. Named vector of linked IDs required for the |
|
| 347 |
#' population, including IDs for "growth", "maturity", and "recruitment". |
|
| 348 |
#' @return |
|
| 349 |
#' The initialized population module as an object. |
|
| 350 |
#' @noRd |
|
| 351 |
initialize_population <- function(parameters, data, linked_ids) {
|
|
| 352 | ! |
if (any(is.na(linked_ids[c("growth", "maturity", "recruitment")]))) {
|
| 353 | ! |
cli::cli_abort(c( |
| 354 | ! |
"{.var linked_ids} for population must include `growth`, `maturity`, and
|
| 355 | ! |
`recruitment` IDs." |
| 356 |
)) |
|
| 357 |
} |
|
| 358 | ||
| 359 | ! |
module <- initialize_module( |
| 360 | ! |
parameters = parameters, |
| 361 | ! |
data = data, |
| 362 | ! |
module_name = setNames("population", "population")
|
| 363 |
) |
|
| 364 | ||
| 365 |
# Link up the recruitment, growth, and maturity modules with |
|
| 366 |
# this population module |
|
| 367 | ! |
module$SetGrowth(linked_ids["growth"]) |
| 368 | ! |
module$SetMaturity(linked_ids["maturity"]) |
| 369 | ! |
module$SetRecruitment(linked_ids["recruitment"]) |
| 370 | ||
| 371 | ! |
return(module) |
| 372 |
} |
|
| 373 | ||
| 374 |
#' Initialize a selectivity module. |
|
| 375 |
#' |
|
| 376 |
#' @description |
|
| 377 |
#' Initializes a selectivity module by setting up fields. This function uses |
|
| 378 |
#' the `initialize_module` function to handle specific requirements for |
|
| 379 |
#' population initialization. |
|
| 380 |
#' @inheritParams initialize_module |
|
| 381 |
#' @param fleet_name A character. Name of the fleet to initialize. |
|
| 382 |
#' @return |
|
| 383 |
#' The initialized selectivity module as an object. |
|
| 384 |
#' @noRd |
|
| 385 |
initialize_selectivity <- function(parameters, data, fleet_name) {
|
|
| 386 | ! |
module <- initialize_module( |
| 387 | ! |
parameters = parameters, |
| 388 | ! |
data = data, |
| 389 | ! |
module_name = setNames(fleet_name, "selectivity") |
| 390 |
) |
|
| 391 | ||
| 392 | ! |
return(module) |
| 393 |
} |
|
| 394 | ||
| 395 |
# TODO: Do we want to put initialize_selectivity(), initialize_index(), and |
|
| 396 |
# initial_age_comp() inside of initialize_fleet()? |
|
| 397 | ||
| 398 |
#' Initialize a fleet module |
|
| 399 |
#' |
|
| 400 |
#' @description |
|
| 401 |
#' Initializes a fleet module by setting up its fields. It links selectivity, |
|
| 402 |
#' index, and age-composition modules. |
|
| 403 |
#' @inheritParams initialize_module |
|
| 404 |
#' @param fleet_name A character. Name of the fleet to initialize. |
|
| 405 |
#' @param linked_ids A vector. Named vector of linked IDs required for the |
|
| 406 |
#' fleet, including IDs for "selectivity", "index", "age_comp", and "length_comp". |
|
| 407 |
#' @return |
|
| 408 |
#' The initialized fleet module as an object. |
|
| 409 |
#' @noRd |
|
| 410 |
initialize_fleet <- function(parameters, data, fleet_name, linked_ids) {
|
|
| 411 | ! |
module <- initialize_module( |
| 412 | ! |
parameters = parameters, |
| 413 | ! |
data = data, |
| 414 | ! |
module_name = setNames(fleet_name, "Fleet") |
| 415 |
) |
|
| 416 | ||
| 417 | ! |
module$SetSelectivity(linked_ids["selectivity"]) |
| 418 | ! |
module$SetObservedIndexData(linked_ids["index"]) |
| 419 | ||
| 420 | ! |
fleet_types <- get_data(data) |> |
| 421 | ! |
dplyr::filter(name == fleet_name) |> |
| 422 | ! |
dplyr::pull(type) |> |
| 423 | ! |
unique() |
| 424 | ||
| 425 |
# Link the observed age composition data to the fleet module using its associated ID |
|
| 426 |
# if the data type includes "age" and if "AgeComp" exists in the data distribution |
|
| 427 |
# specification |
|
| 428 | ! |
distribution_names_for_fleet <- names(parameters[["modules"]][["fleets"]][[fleet_name]][["data_distribution"]]) |
| 429 | ! |
if ("age" %in% fleet_types &&
|
| 430 | ! |
"AgeComp" %in% distribution_names_for_fleet) {
|
| 431 | ! |
module$SetObservedAgeCompData(linked_ids["age_comp"]) |
| 432 |
} |
|
| 433 | ||
| 434 |
# Link the observed length composition data to the fleet module using its associated ID |
|
| 435 |
# if the data type includes "length" and if "LengthComp" exists in the data |
|
| 436 |
# distribution specification |
|
| 437 | ! |
if ("length" %in% fleet_types &&
|
| 438 | ! |
"LengthComp" %in% distribution_names_for_fleet) {
|
| 439 | ! |
module$SetObservedLengthCompData(linked_ids["length_comp"]) |
| 440 |
} |
|
| 441 | ! |
return(module) |
| 442 |
} |
|
| 443 | ||
| 444 |
#' Initialize an index module |
|
| 445 |
#' |
|
| 446 |
#' @description |
|
| 447 |
#' Initializes an index module based on the provided data and fleet name. |
|
| 448 |
#' @inheritParams initialize_module |
|
| 449 |
#' @param fleet_name A character. Name of the fleet for which the index module |
|
| 450 |
#' is initialized. |
|
| 451 |
#' @return |
|
| 452 |
#' The initialized index module as an object. |
|
| 453 |
#' @noRd |
|
| 454 |
initialize_index <- function(data, fleet_name) {
|
|
| 455 |
# Check if the specified fleet exists in the data |
|
| 456 | ! |
fleet_exists <- any(get_data(data)["name"] == fleet_name) |
| 457 | ! |
if (!fleet_exists) {
|
| 458 | ! |
cli::cli_abort("Fleet {fleet_name} not found in the data object.")
|
| 459 |
} |
|
| 460 | ||
| 461 | ! |
fleet_type <- dplyr::filter( |
| 462 | ! |
.data = as.data.frame(data@data), |
| 463 | ! |
name == fleet_name |
| 464 |
) |> |
|
| 465 | ! |
dplyr::distinct(type) |> |
| 466 | ! |
dplyr::pull(type) |
| 467 | ||
| 468 | ||
| 469 | ! |
module <- methods::new(Index, get_n_years(data)) |
| 470 | ||
| 471 | ! |
if ("landings" %in% fleet_type) {
|
| 472 | ! |
module[["index_data"]] <- m_landings(data, fleet_name) |
| 473 | ! |
} else if ("index" %in% fleet_type) {
|
| 474 | ! |
module[["index_data"]] <- m_index(data, fleet_name) |
| 475 |
} else {
|
|
| 476 | ! |
cli::cli_abort(c( |
| 477 | ! |
"Fleet type `{fleet_type}` is not valid for index module initialization.
|
| 478 | ! |
Only 'landings' or 'index' are supported." |
| 479 |
)) |
|
| 480 |
} |
|
| 481 | ||
| 482 | ! |
return(module) |
| 483 |
} |
|
| 484 | ||
| 485 |
#' Initialize an age-composition module |
|
| 486 |
#' |
|
| 487 |
#' @description |
|
| 488 |
#' Initializes an age-composition module for a specific fleet, |
|
| 489 |
#' setting the age-composition data for the fleet over time. |
|
| 490 |
#' @inheritParams initialize_module |
|
| 491 |
#' @param fleet_name A character. Name of the fleet for which age-composition |
|
| 492 |
#' data is initialized. |
|
| 493 |
#' @return |
|
| 494 |
#' The initialized age-composition module as an object. |
|
| 495 |
#' @noRd |
|
| 496 |
initialize_age_comp <- function(data, fleet_name) {
|
|
| 497 |
# Check if the specified fleet exists in the data |
|
| 498 | ! |
fleet_exists <- any(get_data(data)["name"] == fleet_name) |
| 499 | ! |
if (!fleet_exists) {
|
| 500 | ! |
cli::cli_abort("Fleet {fleet_name} not found in the data object.")
|
| 501 |
} |
|
| 502 | ||
| 503 | ! |
module <- methods::new(AgeComp, get_n_years(data), get_n_ages(data)) |
| 504 | ||
| 505 |
# Validate that the fleet's age-composition data is available |
|
| 506 | ! |
age_comp_data <- m_agecomp(data, fleet_name) |
| 507 | ! |
if (is.null(age_comp_data) || length(age_comp_data) == 0) {
|
| 508 | ! |
cli::cli_abort(c( |
| 509 | ! |
"Age-composition data for fleet `{fleet_name}` is unavailable or empty."
|
| 510 |
)) |
|
| 511 |
} |
|
| 512 | ||
| 513 |
# Assign the age-composition data to the module |
|
| 514 |
# TODO: review the AgeComp interface, do we want to add |
|
| 515 |
# `age_comp_data` as an argument? |
|
| 516 | ||
| 517 | ! |
module$age_comp_data <- age_comp_data * |
| 518 | ! |
get_data(data) |> |
| 519 | ! |
dplyr::filter( |
| 520 | ! |
name == fleet_name, |
| 521 | ! |
type == "age" |
| 522 |
) |> |
|
| 523 | ! |
dplyr::mutate( |
| 524 | ! |
valid_n = ifelse(value == -999, 1, uncertainty) |
| 525 |
) |> |
|
| 526 | ! |
dplyr::pull(valid_n) |
| 527 | ||
| 528 | ! |
return(module) |
| 529 |
} |
|
| 530 | ||
| 531 |
# TODO: combine initialize_length_comp and initialize_age_comp() into a single |
|
| 532 |
# function, as they share similar code. |
|
| 533 |
#' Initialize a length-composition module |
|
| 534 |
#' |
|
| 535 |
#' @description |
|
| 536 |
#' Initializes a length-composition module for a specific fleet, |
|
| 537 |
#' setting the length-composition data for the fleet over time. |
|
| 538 |
#' @inheritParams initialize_module |
|
| 539 |
#' @param fleet_name A character. Name of the fleet for which length-composition |
|
| 540 |
#' data is initialized. |
|
| 541 |
#' @return |
|
| 542 |
#' The initialized length-composition module as an object. |
|
| 543 |
#' @noRd |
|
| 544 |
initialize_length_comp <- function(data, fleet_name) {
|
|
| 545 |
# Check if the specified fleet exists in the data |
|
| 546 | ! |
fleet_exists <- any(get_data(data)["name"] == fleet_name) |
| 547 | ! |
if (!fleet_exists) {
|
| 548 | ! |
cli::cli_abort("Fleet {fleet_name} not found in the data object.")
|
| 549 |
} |
|
| 550 | ||
| 551 | ! |
module <- methods::new(LengthComp, get_n_years(data), get_n_lengths(data)) |
| 552 | ||
| 553 |
# Validate that the fleet's length-composition data is available |
|
| 554 | ! |
length_comp_data <- m_lengthcomp(data, fleet_name) |
| 555 | ! |
if (is.null(length_comp_data) || length(length_comp_data) == 0) {
|
| 556 | ! |
cli::cli_abort(c( |
| 557 | ! |
"Length-composition data for fleet `{fleet_name}` is unavailable or empty."
|
| 558 |
)) |
|
| 559 |
} |
|
| 560 | ||
| 561 |
# Assign the length-composition data to the module |
|
| 562 |
# TODO: review the LengthComp interface, do we want to add |
|
| 563 |
# `age_comp_data` as an argument? |
|
| 564 | ||
| 565 | ! |
module$length_comp_data <- length_comp_data * |
| 566 | ! |
get_data(data) |> |
| 567 | ! |
dplyr::filter( |
| 568 | ! |
name == fleet_name, |
| 569 | ! |
type == "length" |
| 570 |
) |> |
|
| 571 | ! |
dplyr::mutate( |
| 572 | ! |
valid_n = ifelse(value == -999, 1, uncertainty) |
| 573 |
) |> |
|
| 574 | ! |
dplyr::pull(valid_n) |
| 575 | ||
| 576 | ! |
return(module) |
| 577 |
} |
|
| 578 | ||
| 579 |
#' Initialize FIMS modules |
|
| 580 |
#' |
|
| 581 |
#' @description |
|
| 582 |
#' Initializes multiple modules within the Fisheries Integrated Modeling System |
|
| 583 |
#' (FIMS), including fleet, recruitment, growth, maturity, and population |
|
| 584 |
#' modules. This function iterates over the provided fleets, setting up |
|
| 585 |
#' necessary sub-modules such as selectivity, index, and age composition. It |
|
| 586 |
#' also sets up distribution models for fishery index and age-composition data. |
|
| 587 |
#' @param parameters A list. Contains parameters and modules required for |
|
| 588 |
#' initialization. |
|
| 589 |
#' @param data An S4 object. FIMS input data. |
|
| 590 |
#' @return |
|
| 591 |
#' A list containing parameters for the initialized FIMS modules, ready for use |
|
| 592 |
#' in TMB modeling. |
|
| 593 |
#' @export |
|
| 594 |
initialize_fims <- function(parameters, data) {
|
|
| 595 |
# Validate parameters input |
|
| 596 | ! |
if (missing(parameters) || !is.list(parameters)) {
|
| 597 | ! |
cli::cli_abort("The {.var parameters} argument must be a non-missing list.")
|
| 598 |
} |
|
| 599 |
# Clear any previous FIMS settings |
|
| 600 | ! |
clear() |
| 601 | ||
| 602 | ! |
module_name <- "fleets" |
| 603 | ! |
fleet_names <- names(parameters[["modules"]][["fleets"]]) |
| 604 | ! |
if (length(fleet_names) == 0) {
|
| 605 | ! |
cli::cli_abort(c( |
| 606 | ! |
"No fleets found in the provided {.var parameters[['modules']]}."
|
| 607 |
)) |
|
| 608 |
} |
|
| 609 | ||
| 610 |
# Initialize lists to store fleet-related objects |
|
| 611 | ! |
fleet <- fleet_selectivity <- |
| 612 | ! |
fleet_index <- fleet_index_distribution <- |
| 613 | ! |
fleet_age_comp <- fleet_agecomp_distribution <- |
| 614 | ! |
fleet_length_comp <- fleet_lengthcomp_distribution <- |
| 615 | ! |
vector("list", length(fleet_names))
|
| 616 | ||
| 617 | ||
| 618 | ! |
for (i in seq_along(fleet_names)) {
|
| 619 | ! |
fleet_selectivity[[i]] <- initialize_selectivity( |
| 620 | ! |
parameters = parameters, |
| 621 | ! |
data = data, |
| 622 | ! |
fleet_name = fleet_names[i] |
| 623 |
) |
|
| 624 | ||
| 625 | ! |
fleet_index[[i]] <- initialize_index( |
| 626 | ! |
data = data, |
| 627 | ! |
fleet_name = fleet_names[i] |
| 628 |
) |
|
| 629 | ||
| 630 | ! |
fleet_module_ids <- c( |
| 631 | ! |
index = fleet_index[[i]]$get_id(), |
| 632 | ! |
selectivity = fleet_selectivity[[i]]$get_id() |
| 633 |
) |
|
| 634 | ||
| 635 | ! |
fleet_types <- get_data(data) |> |
| 636 | ! |
dplyr::filter(name == fleet_names[i]) |> |
| 637 | ! |
dplyr::pull(type) |> |
| 638 | ! |
unique() |
| 639 | ||
| 640 |
# Initialize age composition module if the data type includes "age" and |
|
| 641 |
# if "AgeComp" exists in the data distribution specification |
|
| 642 | ! |
data_distribution_names_for_fleet_i <- names( |
| 643 | ! |
parameters[["modules"]][["fleets"]][[fleet_names[i]]][["data_distribution"]] |
| 644 |
) |
|
| 645 | ||
| 646 | ! |
if ("age" %in% fleet_types &&
|
| 647 | ! |
"AgeComp" %in% data_distribution_names_for_fleet_i) {
|
| 648 |
# Initialize age composition module for the current fleet |
|
| 649 | ! |
fleet_age_comp[[i]] <- initialize_age_comp( |
| 650 | ! |
data = data, |
| 651 | ! |
fleet_name = fleet_names[i] |
| 652 |
) |
|
| 653 | ||
| 654 |
# Add the module ID for the initialized age composition to the list of fleet module IDs |
|
| 655 | ! |
fleet_module_ids <- c( |
| 656 | ! |
fleet_module_ids, |
| 657 | ! |
c(age_comp = fleet_age_comp[[i]]$get_id()) |
| 658 |
) |
|
| 659 |
} |
|
| 660 | ||
| 661 |
# Initialize length composition module if the data type includes "length" and |
|
| 662 |
# if "LengthComp" exists in the data distribution specification |
|
| 663 | ! |
if ("length" %in% fleet_types &&
|
| 664 | ! |
"LengthComp" %in% data_distribution_names_for_fleet_i) {
|
| 665 |
# Initialize length composition module for the current fleet |
|
| 666 | ! |
fleet_length_comp[[i]] <- initialize_length_comp( |
| 667 | ! |
data = data, |
| 668 | ! |
fleet_name = fleet_names[i] |
| 669 |
) |
|
| 670 | ||
| 671 |
# Add the module ID for the initialized length composition to the list of fleet module IDs |
|
| 672 | ! |
fleet_module_ids <- c( |
| 673 | ! |
fleet_module_ids, |
| 674 | ! |
c(length_comp = fleet_length_comp[[i]]$get_id()) |
| 675 |
) |
|
| 676 |
} |
|
| 677 | ||
| 678 | ! |
fleet[[i]] <- initialize_fleet( |
| 679 | ! |
parameters = parameters, |
| 680 | ! |
data = data, |
| 681 | ! |
fleet_name = fleet_names[i], |
| 682 | ! |
linked_ids = fleet_module_ids |
| 683 |
) |
|
| 684 | ||
| 685 |
# TODO: update argument sd to log_sd to match the Rcpp interface |
|
| 686 | ! |
parameter_value_name <- grep( |
| 687 | ! |
paste0("log_sd", ".value"),
|
| 688 | ! |
names(parameters[["parameters"]][[fleet_names[i]]]), |
| 689 | ! |
value = TRUE |
| 690 |
) |
|
| 691 | ! |
parameter_estimated_name <- grep( |
| 692 | ! |
paste0("log_sd", ".estimated"),
|
| 693 | ! |
names(parameters[["parameters"]][[fleet_names[i]]]), |
| 694 | ! |
value = TRUE |
| 695 |
) |
|
| 696 | ||
| 697 | ! |
if (length(parameter_value_name) == 0 || |
| 698 | ! |
length(parameter_estimated_name) == 0 |
| 699 |
) {
|
|
| 700 | ! |
cli::cli_abort(c( |
| 701 | ! |
"Missing required inputs for `log_sd` in fleet `{fleet_name}`."
|
| 702 |
)) |
|
| 703 |
} |
|
| 704 | ||
| 705 | ! |
fleet_index_distribution[[i]] <- initialize_data_distribution( |
| 706 | ! |
module = fleet[[i]], |
| 707 | ! |
family = lognormal(link = "log"), |
| 708 | ! |
sd = list( |
| 709 | ! |
value = exp( |
| 710 | ! |
parameters[["parameters"]][[fleet_names[i]]][[parameter_value_name]] |
| 711 |
), |
|
| 712 | ! |
estimated = parameters[["parameters"]][[fleet_names[i]]][[parameter_estimated_name]] |
| 713 |
), |
|
| 714 | ! |
data_type = "index" |
| 715 |
) |
|
| 716 | ||
| 717 | ! |
if ("age" %in% fleet_types &&
|
| 718 | ! |
"AgeComp" %in% data_distribution_names_for_fleet_i) {
|
| 719 | ! |
fleet_agecomp_distribution[[i]] <- initialize_data_distribution( |
| 720 | ! |
module = fleet[[i]], |
| 721 | ! |
family = multinomial(link = "logit"), |
| 722 | ! |
data_type = "agecomp" |
| 723 |
) |
|
| 724 |
} |
|
| 725 | ||
| 726 | ! |
if ("length" %in% fleet_types &&
|
| 727 | ! |
"LengthComp" %in% data_distribution_names_for_fleet_i) {
|
| 728 | ! |
fleet_lengthcomp_distribution[[i]] <- initialize_data_distribution( |
| 729 | ! |
module = fleet[[i]], |
| 730 | ! |
family = multinomial(link = "logit"), |
| 731 | ! |
data_type = "lengthcomp" |
| 732 |
) |
|
| 733 |
} |
|
| 734 |
} |
|
| 735 | ||
| 736 |
# Recruitment |
|
| 737 |
# create new module in the recruitment class (specifically Beverton--Holt, |
|
| 738 |
# when there are other options, this would be where the option would be |
|
| 739 |
# chosen) |
|
| 740 | ! |
recruitment <- initialize_recruitment( |
| 741 | ! |
parameters = parameters, |
| 742 | ! |
data = data |
| 743 |
) |
|
| 744 | ||
| 745 | ! |
parameter_name <- names(parameters$modules$recruitment$process_distribution) |
| 746 | ! |
field_value_name <- grep( |
| 747 | ! |
paste0("log_sd.value"),
|
| 748 | ! |
names(parameters[["parameters"]][["recruitment"]]), |
| 749 | ! |
value = TRUE |
| 750 |
) |
|
| 751 | ! |
field_estimated_name <- grep( |
| 752 | ! |
paste0("log_sd.estimated"),
|
| 753 | ! |
names(parameters[["parameters"]][["recruitment"]]), |
| 754 | ! |
value = TRUE |
| 755 |
) |
|
| 756 | ||
| 757 | ! |
if (length(field_value_name) == 0 || length(field_estimated_name) == 0) {
|
| 758 | ! |
cli::cli_abort("Missing required inputs for recruitment distribution.")
|
| 759 |
} |
|
| 760 | ||
| 761 | ! |
recruitment_distribution <- initialize_process_distribution( |
| 762 | ! |
module = recruitment, |
| 763 | ! |
par = names(parameters$modules$recruitment$process_distribution), |
| 764 | ! |
family = gaussian(), |
| 765 | ! |
sd = list( |
| 766 | ! |
value = parameters[["parameters"]][["recruitment"]][[field_value_name]], |
| 767 | ! |
estimated = parameters[["parameters"]][[ |
| 768 | ! |
"recruitment" |
| 769 | ! |
]][[field_estimated_name]] |
| 770 |
), |
|
| 771 | ! |
is_random_effect = FALSE |
| 772 |
) |
|
| 773 | ||
| 774 |
# Growth |
|
| 775 | ! |
growth <- initialize_growth( |
| 776 | ! |
parameters = parameters, |
| 777 | ! |
data = data |
| 778 |
) |
|
| 779 | ||
| 780 |
# Maturity |
|
| 781 | ! |
maturity <- initialize_maturity( |
| 782 | ! |
parameters = parameters, |
| 783 | ! |
data = data |
| 784 |
) |
|
| 785 | ||
| 786 | ! |
population_module_ids <- c( |
| 787 | ! |
recruitment = recruitment$get_id(), |
| 788 | ! |
growth = growth$get_id(), |
| 789 | ! |
maturity = maturity$get_id() |
| 790 |
) |
|
| 791 | ||
| 792 |
# Population |
|
| 793 | ! |
population <- initialize_population( |
| 794 | ! |
parameters = parameters, |
| 795 | ! |
data = data, |
| 796 | ! |
linked_ids = population_module_ids |
| 797 |
) |
|
| 798 | ||
| 799 |
# Set-up TMB |
|
| 800 | ! |
CreateTMBModel() |
| 801 |
# Create parameter list from Rcpp modules |
|
| 802 | ! |
parameter_list <- list( |
| 803 | ! |
parameters = list(p = get_fixed()) |
| 804 |
) |
|
| 805 | ||
| 806 | ! |
return(parameter_list) |
| 807 |
} |
|
| 808 | ||
| 809 |
#' Set parameter vector values based on module input |
|
| 810 |
#' |
|
| 811 |
#' @description |
|
| 812 |
#' This function sets the parameter vector values in a module based on the |
|
| 813 |
#' provided module input, including both initial values and estimation |
|
| 814 |
#' information. |
|
| 815 |
#' @param field A character string specifying the field name of the parameter |
|
| 816 |
#' vector to be updated. |
|
| 817 |
#' @param module A module object in which the parameter vector is to be set. |
|
| 818 |
#' @param module_input A list containing input parameters for the module, |
|
| 819 |
#' including value and estimation information for the parameter vector. |
|
| 820 |
#' @return |
|
| 821 |
#' Modified module object. |
|
| 822 |
#' @noRd |
|
| 823 |
set_param_vector <- function(field, module, module_input) {
|
|
| 824 |
# Check if field_name is a non-empty character string |
|
| 825 | ! |
if (missing(field) || !is.character(field) || nchar(field) == 0) {
|
| 826 | ! |
cli::cli_abort(c( |
| 827 | ! |
"The {.var field} argument must be a non-empty character string."
|
| 828 |
)) |
|
| 829 |
} |
|
| 830 | ||
| 831 |
# Check if module is a reference class |
|
| 832 | ! |
if (!is(module, "refClass")) {
|
| 833 | ! |
cli::cli_abort(c( |
| 834 | ! |
"The {.var module} argument must be a reference class created by
|
| 835 | ! |
{.fn methods::new}."
|
| 836 |
)) |
|
| 837 |
} |
|
| 838 | ||
| 839 |
# Check if module_input is a list |
|
| 840 | ! |
if (!is.list(module_input)) {
|
| 841 | ! |
cli::cli_abort("The {.var module_input} argument must be a list.")
|
| 842 |
} |
|
| 843 | ||
| 844 |
# Identify the name for the parameter value and estimation fields in |
|
| 845 |
# module_input |
|
| 846 | ! |
field_value_name <- grep( |
| 847 | ! |
paste0(field, ".value"), |
| 848 | ! |
names(module_input), |
| 849 | ! |
value = TRUE |
| 850 |
) |
|
| 851 | ! |
field_estimated_name <- grep( |
| 852 | ! |
paste0(field, ".estimated"), |
| 853 | ! |
names(module_input), |
| 854 | ! |
value = TRUE |
| 855 |
) |
|
| 856 | ||
| 857 |
# Check if both value and estimation information are present |
|
| 858 | ! |
if (length(field_value_name) == 0 || length(field_estimated_name) == 0) {
|
| 859 | ! |
cli::cli_abort(c( |
| 860 | ! |
"Missing value or estimation information for {.var field}."
|
| 861 |
)) |
|
| 862 |
} |
|
| 863 | ||
| 864 |
# Extract the value of the parameter vector |
|
| 865 | ! |
field_value <- module_input[[field_value_name]] |
| 866 | ||
| 867 |
# Resize the field in the module if it has multiple values |
|
| 868 | ! |
if (length(field_value) > 1) module[[field]]$resize(length(field_value)) |
| 869 | ||
| 870 |
# Assign each value to the corresponding position in the parameter vector |
|
| 871 | ! |
for (i in seq_along(field_value)) {
|
| 872 | ! |
module[[field]][i][["value"]] <- field_value[i] |
| 873 |
} |
|
| 874 | ||
| 875 |
# Set the estimation information for the entire parameter vector |
|
| 876 | ! |
module[[field]]$set_all_estimable(module_input[[field_estimated_name]]) |
| 877 |
} |
| 1 |
# Developers: ---- |
|
| 2 | ||
| 3 |
# This file defines the parent class FIMSFrame and its potential children. The |
|
| 4 |
# class is an S4 class with accessors and validators but no setters. |
|
| 5 |
# |
|
| 6 |
# The top of this file contains the declaration of the FIMSFrame class, which |
|
| 7 |
# is the controller of everything. Then the function FIMSFrame() is how objects |
|
| 8 |
# of that class are created, i.e., the constructor, and how users will interact |
|
| 9 |
# with the class the most. When the returned object from that constructor are |
|
| 10 |
# changed, the call to methods::setClass() that defines the class must also be |
|
| 11 |
# changed. The remainder of the file is set up to help you easily augment this |
|
| 12 |
# class. Follow the step-by-step instructions in order or at least know that |
|
| 13 |
# the functions are present in this order: |
|
| 14 |
# |
|
| 15 |
# 1. Add or remove the slot of interest in the call to `methods::setClass()`, |
|
| 16 |
# e.g., if you are adding a new slot you must declare the slot and the type |
|
| 17 |
# of object that should be expected in that slot; to remove an object from |
|
| 18 |
# the FIMSFrame class you must remove the slot here. |
|
| 19 |
# 2. Add an accessor function, e.g., get_*(), to allow users to access the |
|
| 20 |
# object stored in the new slot; or, remove the accessor function if you |
|
| 21 |
# remove a slot. Some internal accessors are also available, e.g., m_*(), |
|
| 22 |
# and should be used to provide data to a model but should not be used by |
|
| 23 |
# average users. |
|
| 24 |
# 3. If we had setter functions for FIMSFrame, you would add or delete the |
|
| 25 |
# appropriate setter functions next but we do not. Instead, we want users to |
|
| 26 |
# re-run FIMSFrame() when they make any changes to their data, that way all |
|
| 27 |
# of the slots will be updated simultaneously. @nathanvaughan-NOAA mentioned |
|
| 28 |
# during Code club 2024-12-17 that this may be a problem for future use of |
|
| 29 |
# FIMSFrame objects, especially when doing MSE or simulation when there is a |
|
| 30 |
# large overhead in running FIMSFrame and you just want to change a small, |
|
| 31 |
# simple thing in your data and re-run the model. We will cross that bridge |
|
| 32 |
# later. @msupernaw also informed us about the ability to lock an R object |
|
| 33 |
# so it cannot be altered. See https://rdrr.io/r/base/bindenv.html. |
|
| 34 |
# 4. Augment the validator functions to ensure that users do not pass |
|
| 35 |
# incompatible information to FIMSFrame(). |
|
| 36 |
# 5. Augment FIMSFrame() to ensure that the slot is created if you are adding a |
|
| 37 |
# new object or remove the object from the returned object if you are |
|
| 38 |
# removing a slot. |
|
| 39 | ||
| 40 |
# TODO: ---- |
|
| 41 | ||
| 42 |
# TODO: remove or change get_fleets to return fleet names in alphabetized order |
|
| 43 |
# TODO: n_fleets should store total number of fleets, i.e., fishing + survey |
|
| 44 |
# TODO: make date_formats a local variable |
|
| 45 |
# TODO: document sorting of information in terms of alphabetized fleet order |
|
| 46 |
# TODO: test implement addition of -999 |
|
| 47 |
# TODO: validate that all length-age combinations exist in the conversion matrix |
|
| 48 | ||
| 49 |
# methods::setClass: ---- |
|
| 50 | ||
| 51 |
# Classes are not currently exported, and therefore, do not need documentation. |
|
| 52 |
# See the following link if we do want to document them in the future: |
|
| 53 |
# https://stackoverflow.com/questions/7368262/how-to-properly-document-s4-class-slots-using-roxygen2 |
|
| 54 | ||
| 55 |
methods::setClass( |
|
| 56 |
Class = "FIMSFrame", |
|
| 57 |
slots = c( |
|
| 58 |
data = "tbl_df", |
|
| 59 |
fleets = "numeric", |
|
| 60 |
n_years = "integer", |
|
| 61 |
ages = "numeric", |
|
| 62 |
n_ages = "integer", |
|
| 63 |
lengths = "numeric", |
|
| 64 |
n_lengths = "integer", |
|
| 65 |
start_year = "integer", |
|
| 66 |
end_year = "integer" |
|
| 67 |
) |
|
| 68 |
) |
|
| 69 | ||
| 70 |
# methods::setMethod: accessors ---- |
|
| 71 | ||
| 72 |
# Methods for accessing info in the slots using get_*() or m_*() |
|
| 73 | ||
| 74 |
#' Get a slot in a FIMSFrame object |
|
| 75 |
#' |
|
| 76 |
#' There is an accessor function for each slot in the S4 class `FIMSFrame`, |
|
| 77 |
#' where the function is named `get_*()` and the star can be replaced with the |
|
| 78 |
#' slot name, e.g., [get_data()]. These accessor functions are the preferred |
|
| 79 |
#' way to access objects stored in the available slots. |
|
| 80 |
#' |
|
| 81 |
#' @param x An object returned from [FIMSFrame()]. |
|
| 82 |
#' @name get_FIMSFrame |
|
| 83 |
#' @keywords FIMSFrame |
|
| 84 |
NULL |
|
| 85 | ||
| 86 |
#' @return |
|
| 87 |
#' [get_data()] returns a data frame of the class `tbl_df` containing data for |
|
| 88 |
#' a FIMS model in a long format. The tibble will potentially have the |
|
| 89 |
#' following columns depending if it fits to ages and lengths or just one of |
|
| 90 |
#' them: |
|
| 91 |
#' `r glue::glue_collapse(colnames(data1), sep = ", ", last = ", and ")`. |
|
| 92 |
#' @export |
|
| 93 |
#' @rdname get_FIMSFrame |
|
| 94 |
#' @keywords FIMSFrame |
|
| 95 | ! |
methods::setGeneric("get_data", function(x) standardGeneric("get_data"))
|
| 96 |
#' @rdname get_FIMSFrame |
|
| 97 |
#' @keywords FIMSFrame |
|
| 98 | ! |
methods::setMethod("get_data", "FIMSFrame", function(x) x@data)
|
| 99 |
#' @rdname get_FIMSFrame |
|
| 100 |
#' @keywords FIMSFrame |
|
| 101 |
methods::setMethod( |
|
| 102 |
"get_data", |
|
| 103 |
"data.frame", |
|
| 104 | ! |
function(x) FIMSFrame(x)@data |
| 105 |
) |
|
| 106 | ||
| 107 |
#' @return |
|
| 108 |
#' [get_fleets()] returns a vector of integer values specifying which fleets in |
|
| 109 |
#' the model are fishing fleets. |
|
| 110 |
#' @export |
|
| 111 |
#' @rdname get_FIMSFrame |
|
| 112 |
#' @keywords FIMSFrame |
|
| 113 | ! |
methods::setGeneric("get_fleets", function(x) standardGeneric("get_fleets"))
|
| 114 |
#' @rdname get_FIMSFrame |
|
| 115 |
#' @keywords FIMSFrame |
|
| 116 | ! |
methods::setMethod("get_fleets", "FIMSFrame", function(x) x@fleets)
|
| 117 |
#' @rdname get_FIMSFrame |
|
| 118 |
#' @keywords FIMSFrame |
|
| 119 |
methods::setMethod( |
|
| 120 |
"get_fleets", |
|
| 121 |
"data.frame", |
|
| 122 | ! |
function(x) FIMSFrame(x)@fleets |
| 123 |
) |
|
| 124 | ||
| 125 |
#' @return |
|
| 126 |
#' [get_n_years()] returns an integer specifying the number of years in the |
|
| 127 |
#' model. |
|
| 128 |
#' @export |
|
| 129 |
#' @rdname get_FIMSFrame |
|
| 130 |
#' @keywords FIMSFrame |
|
| 131 | ! |
methods::setGeneric("get_n_years", function(x) standardGeneric("get_n_years"))
|
| 132 |
#' @rdname get_FIMSFrame |
|
| 133 |
#' @keywords FIMSFrame |
|
| 134 | ! |
methods::setMethod("get_n_years", "FIMSFrame", function(x) x@n_years)
|
| 135 |
#' @rdname get_FIMSFrame |
|
| 136 |
#' @keywords FIMSFrame |
|
| 137 |
methods::setMethod( |
|
| 138 |
"get_n_years", |
|
| 139 |
"data.frame", |
|
| 140 | ! |
function(x) FIMSFrame(x)@n_years |
| 141 |
) |
|
| 142 | ||
| 143 |
#' @return |
|
| 144 |
#' [get_start_year()] returns an integer specifying the start year of the |
|
| 145 |
#' model. |
|
| 146 |
#' @export |
|
| 147 |
#' @rdname get_FIMSFrame |
|
| 148 |
#' @keywords FIMSFrame |
|
| 149 |
methods::setGeneric( |
|
| 150 |
"get_start_year", |
|
| 151 | ! |
function(x) standardGeneric("get_start_year")
|
| 152 |
) |
|
| 153 |
#' @rdname get_FIMSFrame |
|
| 154 |
#' @keywords FIMSFrame |
|
| 155 | ! |
methods::setMethod("get_start_year", "FIMSFrame", function(x) x@start_year)
|
| 156 |
#' @rdname get_FIMSFrame |
|
| 157 |
#' @keywords FIMSFrame |
|
| 158 |
methods::setMethod( |
|
| 159 |
"get_start_year", |
|
| 160 |
"data.frame", |
|
| 161 | ! |
function(x) FIMSFrame(x)@start_year |
| 162 |
) |
|
| 163 | ||
| 164 |
#' @return |
|
| 165 |
#' [get_end_year()] returns an integer specifying the end year of the |
|
| 166 |
#' model. |
|
| 167 |
#' @export |
|
| 168 |
#' @rdname get_FIMSFrame |
|
| 169 |
#' @keywords FIMSFrame |
|
| 170 | ! |
methods::setGeneric("get_end_year", function(x) standardGeneric("get_end_year"))
|
| 171 |
#' @rdname get_FIMSFrame |
|
| 172 |
#' @keywords FIMSFrame |
|
| 173 | ! |
methods::setMethod("get_end_year", "FIMSFrame", function(x) x@end_year)
|
| 174 |
#' @rdname get_FIMSFrame |
|
| 175 |
#' @keywords FIMSFrame |
|
| 176 |
methods::setMethod( |
|
| 177 |
"get_end_year", |
|
| 178 |
"data.frame", |
|
| 179 | ! |
function(x) FIMSFrame(x)@end_year |
| 180 |
) |
|
| 181 | ||
| 182 |
#' @return |
|
| 183 |
#' [get_ages()] returns a vector of age bins used in the model. |
|
| 184 |
#' @export |
|
| 185 |
#' @rdname get_FIMSFrame |
|
| 186 |
#' @keywords FIMSFrame |
|
| 187 | ! |
methods::setGeneric("get_ages", function(x) standardGeneric("get_ages"))
|
| 188 |
#' @rdname get_FIMSFrame |
|
| 189 |
#' @keywords FIMSFrame |
|
| 190 | ! |
methods::setMethod("get_ages", "FIMSFrame", function(x) x@ages)
|
| 191 |
#' @rdname get_FIMSFrame |
|
| 192 |
#' @keywords FIMSFrame |
|
| 193 |
methods::setMethod( |
|
| 194 |
"get_ages", |
|
| 195 |
"data.frame", |
|
| 196 | ! |
function(x) FIMSFrame(x)@ages |
| 197 |
) |
|
| 198 | ||
| 199 |
#' @return |
|
| 200 |
#' [get_n_ages()] returns an integer specifying the number of age bins used in |
|
| 201 |
#' the model. |
|
| 202 |
#' @export |
|
| 203 |
#' @rdname get_FIMSFrame |
|
| 204 |
#' @keywords FIMSFrame |
|
| 205 | ! |
methods::setGeneric("get_n_ages", function(x) standardGeneric("get_n_ages"))
|
| 206 |
#' @rdname get_FIMSFrame |
|
| 207 |
#' @keywords FIMSFrame |
|
| 208 | ! |
methods::setMethod("get_n_ages", "FIMSFrame", function(x) x@n_ages)
|
| 209 |
#' @rdname get_FIMSFrame |
|
| 210 |
#' @keywords FIMSFrame |
|
| 211 |
methods::setMethod( |
|
| 212 |
"get_n_ages", |
|
| 213 |
"data.frame", |
|
| 214 | ! |
function(x) FIMSFrame(x)@n_ages |
| 215 |
) |
|
| 216 | ||
| 217 |
#' @return |
|
| 218 |
#' [get_lengths()] returns a vector of length bins used in the model. |
|
| 219 |
#' @export |
|
| 220 |
#' @rdname get_FIMSFrame |
|
| 221 |
#' @keywords FIMSFrame |
|
| 222 | ! |
methods::setGeneric("get_lengths", function(x) standardGeneric("get_lengths"))
|
| 223 |
#' @rdname get_FIMSFrame |
|
| 224 |
#' @keywords FIMSFrame |
|
| 225 | ! |
methods::setMethod("get_lengths", "FIMSFrame", function(x) x@lengths)
|
| 226 |
#' @rdname get_FIMSFrame |
|
| 227 |
#' @keywords FIMSFrame |
|
| 228 |
methods::setMethod( |
|
| 229 |
"get_lengths", |
|
| 230 |
"data.frame", |
|
| 231 | ! |
function(x) FIMSFrame(x)@lengths |
| 232 |
) |
|
| 233 | ||
| 234 |
#' @return |
|
| 235 |
#' [get_n_lengths()] returns an integer specifying the number of length bins |
|
| 236 |
#' used in the model. |
|
| 237 |
#' @export |
|
| 238 |
#' @rdname get_FIMSFrame |
|
| 239 |
#' @keywords FIMSFrame |
|
| 240 |
methods::setGeneric( |
|
| 241 |
"get_n_lengths", |
|
| 242 | ! |
function(x) standardGeneric("get_n_lengths")
|
| 243 |
) |
|
| 244 |
#' @rdname get_FIMSFrame |
|
| 245 |
#' @keywords FIMSFrame |
|
| 246 | ! |
methods::setMethod("get_n_lengths", "FIMSFrame", function(x) x@n_lengths)
|
| 247 |
#' @rdname get_FIMSFrame |
|
| 248 |
#' @keywords FIMSFrame |
|
| 249 |
methods::setMethod( |
|
| 250 |
"get_n_lengths", |
|
| 251 |
"data.frame", |
|
| 252 | ! |
function(x) FIMSFrame(x)@n_lengths |
| 253 |
) |
|
| 254 | ||
| 255 |
#' Get a vector of data to be passed to a FIMS module from a FIMSFrame object |
|
| 256 |
#' |
|
| 257 |
#' There is an accessor function for each data type needed to run a FIMS model. |
|
| 258 |
#' A FIMS model accepts vectors of data and thus each of the `m_*()` functions, |
|
| 259 |
#' where the star can be replaced with the data type separated by underscores, |
|
| 260 |
#' e.g., weight_at_age. These accessor functions are the preferred way to pass |
|
| 261 |
#' data to a FIMS module because the data will have the appropriate indexing. |
|
| 262 |
#' |
|
| 263 |
#' @details |
|
| 264 |
#' Age-to-length-conversion data, i.e., the proportion of age "a" that are |
|
| 265 |
#' length "l", are used to convert lengths (input data) to ages (modeled) as |
|
| 266 |
#' a way to fit length data without estimating growth. |
|
| 267 |
#' |
|
| 268 |
#' @inheritParams get_data |
|
| 269 |
#' @param fleet_name A string, or vector of strings, specifying the name of the |
|
| 270 |
#' fleet(s) of interest that you want landings data for. The strings must |
|
| 271 |
#' exactly match strings in the column `"name"` of `get_data(x)`. |
|
| 272 |
#' @return |
|
| 273 |
#' All of the `m_*()` functions return vectors of data. Currently, the order of |
|
| 274 |
#' the data is the same order as the data frame because no arranging is done in |
|
| 275 |
#' [FIMSFrame()] and the function just extracts the appropriate column. |
|
| 276 |
#' @name m_ |
|
| 277 |
#' @keywords FIMSFrame |
|
| 278 |
NULL |
|
| 279 | ||
| 280 |
#' @export |
|
| 281 |
#' @rdname m_ |
|
| 282 |
#' @keywords FIMSFrame |
|
| 283 |
methods::setGeneric( |
|
| 284 |
"m_landings", |
|
| 285 | ! |
function(x, fleet_name) standardGeneric("m_landings")
|
| 286 |
) |
|
| 287 |
#' @rdname m_ |
|
| 288 |
#' @keywords FIMSFrame |
|
| 289 |
methods::setMethod( |
|
| 290 |
"m_landings", "FIMSFrame", |
|
| 291 |
function(x, fleet_name) {
|
|
| 292 | ! |
dplyr::filter( |
| 293 | ! |
.data = x@data, |
| 294 | ! |
.data[["type"]] == "landings", |
| 295 | ! |
.data[["name"]] %in% fleet_name |
| 296 |
) |> |
|
| 297 | ! |
dplyr::pull(.data[["value"]]) |
| 298 |
} |
|
| 299 |
) |
|
| 300 |
#' @rdname m_ |
|
| 301 |
#' @keywords FIMSFrame |
|
| 302 |
methods::setMethod( |
|
| 303 |
"m_landings", |
|
| 304 |
"data.frame", |
|
| 305 | ! |
function(x, fleet_name) m_landings(FIMSFrame(x), fleet_name) |
| 306 |
) |
|
| 307 | ||
| 308 |
#' @export |
|
| 309 |
#' @rdname m_ |
|
| 310 |
#' @keywords FIMSFrame |
|
| 311 |
methods::setGeneric( |
|
| 312 |
"m_index", |
|
| 313 | ! |
function(x, fleet_name) standardGeneric("m_index")
|
| 314 |
) |
|
| 315 |
#' @rdname m_ |
|
| 316 |
#' @keywords FIMSFrame |
|
| 317 |
methods::setMethod( |
|
| 318 |
"m_index", "FIMSFrame", |
|
| 319 |
function(x, fleet_name) {
|
|
| 320 | ! |
dplyr::filter( |
| 321 | ! |
.data = x@data, |
| 322 | ! |
.data[["type"]] == "index", |
| 323 | ! |
.data[["name"]] %in% fleet_name |
| 324 |
) |> |
|
| 325 | ! |
dplyr::pull(.data[["value"]]) |
| 326 |
} |
|
| 327 |
) |
|
| 328 |
#' @rdname m_ |
|
| 329 |
#' @keywords FIMSFrame |
|
| 330 |
methods::setMethod( |
|
| 331 |
"m_index", |
|
| 332 |
"data.frame", |
|
| 333 | ! |
function(x, fleet_name) m_index(FIMSFrame(x), fleet_name) |
| 334 |
) |
|
| 335 | ||
| 336 |
#' @export |
|
| 337 |
#' @rdname m_ |
|
| 338 |
#' @keywords FIMSFrame |
|
| 339 |
methods::setGeneric( |
|
| 340 |
"m_agecomp", |
|
| 341 | ! |
function(x, fleet_name) standardGeneric("m_agecomp")
|
| 342 |
) |
|
| 343 |
#' @rdname m_ |
|
| 344 |
#' @keywords FIMSFrame |
|
| 345 |
methods::setMethod( |
|
| 346 |
"m_agecomp", "FIMSFrame", |
|
| 347 |
function(x, fleet_name) {
|
|
| 348 | ! |
dplyr::filter( |
| 349 | ! |
.data = x@data, |
| 350 | ! |
.data[["type"]] == "age", |
| 351 | ! |
.data[["name"]] %in% fleet_name |
| 352 |
) |> |
|
| 353 | ! |
dplyr::pull(.data[["value"]]) |
| 354 |
} |
|
| 355 |
) |
|
| 356 |
#' @rdname m_ |
|
| 357 |
#' @keywords FIMSFrame |
|
| 358 |
methods::setMethod( |
|
| 359 |
"m_agecomp", |
|
| 360 |
"data.frame", |
|
| 361 | ! |
function(x, fleet_name) m_agecomp(FIMSFrame(x), fleet_name) |
| 362 |
) |
|
| 363 | ||
| 364 |
#' @export |
|
| 365 |
#' @rdname m_ |
|
| 366 |
#' @keywords FIMSFrame |
|
| 367 |
methods::setGeneric( |
|
| 368 |
"m_lengthcomp", |
|
| 369 | ! |
function(x, fleet_name) standardGeneric("m_lengthcomp")
|
| 370 |
) |
|
| 371 |
#' @rdname m_ |
|
| 372 |
#' @keywords FIMSFrame |
|
| 373 |
methods::setMethod( |
|
| 374 |
"m_lengthcomp", |
|
| 375 |
"FIMSFrame", |
|
| 376 |
function(x, fleet_name) {
|
|
| 377 | ! |
dplyr::filter( |
| 378 | ! |
.data = x@data, |
| 379 | ! |
.data[["type"]] == "length", |
| 380 | ! |
.data[["name"]] %in% fleet_name |
| 381 |
) |> |
|
| 382 | ! |
dplyr::pull(.data[["value"]]) |
| 383 |
} |
|
| 384 |
) |
|
| 385 |
#' @rdname m_ |
|
| 386 |
#' @keywords FIMSFrame |
|
| 387 |
methods::setMethod( |
|
| 388 |
"m_lengthcomp", |
|
| 389 |
"data.frame", |
|
| 390 | ! |
function(x, fleet_name) m_lengthcomp(FIMSFrame(x), fleet_name) |
| 391 |
) |
|
| 392 | ||
| 393 |
#' @export |
|
| 394 |
#' @rdname m_ |
|
| 395 |
#' @keywords FIMSFrame |
|
| 396 |
methods::setGeneric( |
|
| 397 |
"m_weight_at_age", |
|
| 398 | ! |
function(x) standardGeneric("m_weight_at_age")
|
| 399 |
) |
|
| 400 |
#' @rdname m_ |
|
| 401 |
#' @keywords FIMSFrame |
|
| 402 |
methods::setMethod( |
|
| 403 |
"m_weight_at_age", |
|
| 404 |
"FIMSFrame", |
|
| 405 |
function(x) {
|
|
| 406 | ! |
dplyr::filter( |
| 407 | ! |
.data = as.data.frame(x@data), |
| 408 | ! |
.data[["type"]] == "weight-at-age" |
| 409 |
) |> |
|
| 410 | ! |
dplyr::group_by(.data[["age"]]) |> |
| 411 | ! |
dplyr::mutate( |
| 412 | ! |
value = ifelse(value == -999, NA, value) |
| 413 |
) |> |
|
| 414 | ! |
dplyr::summarize(mean_value = mean(.data[["value"]], na.rm = TRUE)) |> |
| 415 | ! |
dplyr::pull(.data[["mean_value"]]) |
| 416 |
} |
|
| 417 |
) |
|
| 418 |
#' @rdname m_ |
|
| 419 |
#' @keywords FIMSFrame |
|
| 420 |
methods::setMethod( |
|
| 421 |
"m_weight_at_age", |
|
| 422 |
"data.frame", |
|
| 423 |
function(x) {
|
|
| 424 | ! |
m_weight_at_age(FIMSFrame(x)) |
| 425 |
} |
|
| 426 |
) |
|
| 427 | ||
| 428 |
#' @export |
|
| 429 |
#' @rdname m_ |
|
| 430 |
#' @keywords FIMSFrame |
|
| 431 |
methods::setGeneric( |
|
| 432 |
"m_age_to_length_conversion", |
|
| 433 | ! |
function(x, fleet_name) standardGeneric("m_age_to_length_conversion")
|
| 434 |
) |
|
| 435 |
#' @rdname m_ |
|
| 436 |
#' @keywords FIMSFrame |
|
| 437 |
methods::setMethod( |
|
| 438 |
"m_age_to_length_conversion", |
|
| 439 |
"FIMSFrame", |
|
| 440 |
function(x, fleet_name) {
|
|
| 441 | ! |
if ("length" %in% colnames(x@data)) {
|
| 442 | ! |
dplyr::filter( |
| 443 | ! |
.data = as.data.frame(x@data), |
| 444 | ! |
.data[["type"]] == "age-to-length-conversion", |
| 445 | ! |
.data[["name"]] %in% fleet_name |
| 446 |
) |> |
|
| 447 | ! |
dplyr::group_by(.data[["age"]], .data[["length"]]) |> |
| 448 | ! |
dplyr::summarize( |
| 449 | ! |
mean_value = mean(as.numeric(.data[["value"]]), na.rm = TRUE) |
| 450 |
) |> |
|
| 451 | ! |
dplyr::pull(as.numeric(.data[["mean_value"]])) |
| 452 |
} |
|
| 453 |
} |
|
| 454 |
) |
|
| 455 |
#' @rdname m_ |
|
| 456 |
#' @keywords FIMSFrame |
|
| 457 |
methods::setMethod( |
|
| 458 |
"m_age_to_length_conversion", |
|
| 459 |
"data.frame", |
|
| 460 | ! |
function(x, fleet_name) m_age_to_length_conversion(FIMSFrame(x), fleet_name) |
| 461 |
) |
|
| 462 | ||
| 463 |
# methods::setMethod: initialize ---- |
|
| 464 | ||
| 465 |
# Not currently using methods::setMethod(f = "initialize") |
|
| 466 |
# because @kellijohnson-NOAA did not quite understand how they actually work. |
|
| 467 | ||
| 468 |
# methods::setMethod: plot ---- |
|
| 469 | ||
| 470 |
methods::setMethod( |
|
| 471 |
f = "plot", |
|
| 472 |
signature = "FIMSFrame", |
|
| 473 |
definition = function(x, y, ...) {
|
|
| 474 | ! |
ggplot2::ggplot( |
| 475 | ! |
data = x@data, |
| 476 | ! |
mapping = ggplot2::aes( |
| 477 | ! |
x = as.Date(.data[["datestart"]]), |
| 478 | ! |
y = .data[["value"]], |
| 479 | ! |
col = .data[["name"]] |
| 480 |
) |
|
| 481 |
) + |
|
| 482 |
# Using Set3 b/c it is the palette with the largest number of colors |
|
| 483 |
# and not {nmfspalette} b/c didn't want to depend on GitHub package
|
|
| 484 | ! |
ggplot2::scale_color_brewer(palette = "Set3") + |
| 485 | ! |
ggplot2::facet_wrap("type", scales = "free_y") +
|
| 486 | ! |
ggplot2::geom_point() + |
| 487 | ! |
ggplot2::scale_x_date(labels = scales::date_format("%Y-%m-%d")) +
|
| 488 | ! |
ggplot2::xlab("Start date (Year-Month-Day)") +
|
| 489 | ! |
ggplot2::ylab("Value") +
|
| 490 | ! |
ggplot2::theme( |
| 491 | ! |
axis.text.x = ggplot2::element_text(angle = 15) |
| 492 |
) |
|
| 493 |
} |
|
| 494 |
) |
|
| 495 | ||
| 496 |
# methods::setMethod: show ---- |
|
| 497 | ||
| 498 |
methods::setMethod( |
|
| 499 |
f = "show", |
|
| 500 |
signature = "FIMSFrame", |
|
| 501 |
definition = function(object) {
|
|
| 502 | ! |
message("tbl_df of class '", class(object), "'")
|
| 503 | ! |
if (length(object@data) == 0) {
|
| 504 | ! |
return() |
| 505 |
} |
|
| 506 | ! |
dat_types <- unique(object@data[[which(colnames(object@data) == "type")]]) |
| 507 | ! |
message("with the following 'types': ", paste0(dat_types, collapse = ", "))
|
| 508 | ! |
snames <- slotNames(object) |
| 509 | ! |
ordinnames <- !snames %in% c( |
| 510 | ! |
"data", |
| 511 | ! |
".S3Class", |
| 512 | ! |
"row.names", |
| 513 | ! |
"names" |
| 514 |
) |
|
| 515 | ! |
print(utils::head(object@data)) |
| 516 | ! |
cat("additional slots include the following:")
|
| 517 | ! |
for (nm in snames[ordinnames]) {
|
| 518 | ! |
cat(nm, ":\n", sep = "") |
| 519 | ! |
print(slot(object, nm)) |
| 520 |
} |
|
| 521 |
} |
|
| 522 |
) |
|
| 523 | ||
| 524 |
is.FIMSFrame <- function(x) {
|
|
| 525 | ! |
inherits(x, "FIMSFrame") |
| 526 |
} |
|
| 527 | ||
| 528 |
# methods::setValidity ---- |
|
| 529 | ||
| 530 |
methods::setValidity( |
|
| 531 |
Class = "FIMSFrame", |
|
| 532 |
method = function(object) {
|
|
| 533 |
errors <- character() |
|
| 534 | ||
| 535 |
if (NROW(object@data) == 0) {
|
|
| 536 |
errors <- c(errors, "data must have at least one row") |
|
| 537 |
} |
|
| 538 | ||
| 539 |
# FIMS models currently cannot run without weight-at-age data |
|
| 540 |
weight_at_age_data <- dplyr::filter(object@data, type == "weight-at-age") |
|
| 541 |
if (NROW(weight_at_age_data) == 0) {
|
|
| 542 |
errors <- c(errors, "data must contain data of the type weight-at-age") |
|
| 543 |
} |
|
| 544 | ||
| 545 |
errors <- c(errors, validate_data_colnames(object@data)) |
|
| 546 | ||
| 547 |
# Add checks for other slots |
|
| 548 |
# Check the format for acceptable variants of the ideal yyyy-mm-dd |
|
| 549 |
grepl_datestart <- grepl( |
|
| 550 |
"[0-9]{1,4}-[0-9]{1,2}-[0-9]{1-2}",
|
|
| 551 |
object@data[["datestart"]] |
|
| 552 |
) |
|
| 553 |
grepl_dateend <- grepl( |
|
| 554 |
"[0-9]{1,4}-[0-9]{1,2}-[0-9]{1-2}",
|
|
| 555 |
object@data[["dateend"]] |
|
| 556 |
) |
|
| 557 |
if (!all(grepl_datestart)) {
|
|
| 558 |
errors <- c(errors, "datestart must be in 'yyyy-mm-dd' format") |
|
| 559 |
} |
|
| 560 |
if (!all(grepl_dateend)) {
|
|
| 561 |
errors <- c(errors, "dateend must be in 'yyyy-mm-dd' format") |
|
| 562 |
} |
|
| 563 | ||
| 564 |
# Return |
|
| 565 |
if (length(errors) == 0) {
|
|
| 566 |
return(TRUE) |
|
| 567 |
} else {
|
|
| 568 |
return(errors) |
|
| 569 |
} |
|
| 570 |
} |
|
| 571 |
) |
|
| 572 | ||
| 573 |
validate_data_colnames <- function(data) {
|
|
| 574 | ! |
the_column_names <- colnames(data) |
| 575 | ! |
errors <- character() |
| 576 | ! |
if (!"type" %in% the_column_names) {
|
| 577 | ! |
errors <- c(errors, "data must contain 'type'") |
| 578 |
} |
|
| 579 | ! |
if (!"name" %in% the_column_names) {
|
| 580 | ! |
errors <- c(errors, "data must contain 'name'") |
| 581 |
} |
|
| 582 | ! |
if (!"datestart" %in% the_column_names) {
|
| 583 | ! |
errors <- c(errors, "data must contain 'datestart'") |
| 584 |
} |
|
| 585 | ! |
if (!"dateend" %in% the_column_names) {
|
| 586 | ! |
errors <- c(errors, "data must contain 'dateend'") |
| 587 |
} |
|
| 588 | ! |
if (!"dateend" %in% the_column_names) {
|
| 589 | ! |
errors <- c(errors, "data must contain 'value'") |
| 590 |
} |
|
| 591 | ! |
if (!"dateend" %in% the_column_names) {
|
| 592 | ! |
errors <- c(errors, "data must contain 'unit'") |
| 593 |
} |
|
| 594 | ! |
if (!"dateend" %in% the_column_names) {
|
| 595 | ! |
errors <- c(errors, "data must contain 'uncertainty'") |
| 596 |
} |
|
| 597 | ! |
if (!any(c("age", "length") %in% the_column_names)) {
|
| 598 | ! |
errors <- c(errors, "data must contain 'ages' and/or 'lengths'") |
| 599 |
} |
|
| 600 | ! |
return(errors) |
| 601 |
} |
|
| 602 | ||
| 603 |
# Constructors ---- |
|
| 604 | ||
| 605 |
# All constructors in this file are documented in 1 roxygen file via @rdname. |
|
| 606 | ||
| 607 |
#' Class constructors for `FIMSFrame` and associated child classes |
|
| 608 |
#' |
|
| 609 |
#' All constructor functions take a single input and build an object specific |
|
| 610 |
#' to the needs of each model type within \pkg{FIMS}. `FIMSFrame` is the parent
|
|
| 611 |
#' class. Future, associated child classes will have the additional slots |
|
| 612 |
#' needed for different types of models. |
|
| 613 |
#' |
|
| 614 |
#' @details |
|
| 615 |
#' ## data |
|
| 616 |
#' The input data are both sorted and expanded before returning them in the |
|
| 617 |
#' data slot. |
|
| 618 |
#' ### Sorting |
|
| 619 |
#' It is important that the order of the rows in the data are correct but it is |
|
| 620 |
#' not expected that the user will do this. Instead, the returned data are |
|
| 621 |
#' sorted using [dplyr::arrange()] before placing them in the data slot. Data |
|
| 622 |
#' are first sorted by data type, placing all weight-at-age data next to other |
|
| 623 |
#' weight-at-age data and all landings data next to landings data. Thus, |
|
| 624 |
#' age-composition data will come first because their type is "age" and "a" is |
|
| 625 |
#' first in the alphabet. All other types will follow according to their order |
|
| 626 |
#' in the alphabet. |
|
| 627 |
#' Next, within each type, data are organized by fleet. So, age-composition |
|
| 628 |
#' information for fleet1 will come before survey1. Next, all data within type |
|
| 629 |
#' and fleet are arranged by datestart, e.g., by year. That is the end of the |
|
| 630 |
#' sorting for time series data like landings and indices. |
|
| 631 |
#' The biological data are further sorted by bin. Thus, age-composition |
|
| 632 |
#' information will be arranged as follows: |
|
| 633 |
#' |
|
| 634 |
#' | type | name | datestart | age | value | |
|
| 635 |
#' |:---- |:--------:|:----------:|:----:|-------:| |
|
| 636 |
#' | age | fleet1 | 2022-01-01 | 1 | 0.3 | |
|
| 637 |
#' | age | fleet1 | 2022-01-01 | 2 | 0.7 | |
|
| 638 |
#' | age | fleet1 | 2023-01-01 | 1 | 0.5 | |
|
| 639 |
#' |
|
| 640 |
#' Length composition-data are sorted the same way but by length bin instead of |
|
| 641 |
#' by age bin. It becomes more complicated for the age-to-length-conversion |
|
| 642 |
#' data, which are sorted by type, name, datestart, age, and then length. So, a |
|
| 643 |
#' full set of length, e.g., length 10, length 20, length 30, etc., is placed |
|
| 644 |
#' together for a given age. After that age, another entire set of length |
|
| 645 |
#' information will be provided for that next age. Once the year is complete |
|
| 646 |
#' for a given fleet then the next year will begin. |
|
| 647 |
#' |
|
| 648 |
#' @rdname FIMSFrame |
|
| 649 |
#' |
|
| 650 |
#' @param data A `data.frame` that contains the necessary columns to construct |
|
| 651 |
#' a `FIMSFrame-class` object. Currently, those columns are |
|
| 652 |
#' `r glue::glue_collapse(colnames(data1), sep = ", ", last = ", and ")`. See |
|
| 653 |
#' the data1 object in FIMS, e.g., `data(data1, package = "FIMS")`. |
|
| 654 |
#' |
|
| 655 |
#' @return |
|
| 656 |
#' An object of the S4 class `FIMSFrame` class, or one of its child classes, is |
|
| 657 |
#' validated and then returned. All objects will at a minimum have a slot |
|
| 658 |
#' called `data` to store the input data frame. Additional slots are dependent |
|
| 659 |
#' on the child class. Use [methods::showClass()] to see all available slots. |
|
| 660 |
#' @export |
|
| 661 |
#' @keywords FIMSFrame |
|
| 662 |
FIMSFrame <- function(data) {
|
|
| 663 | ! |
errors <- validate_data_colnames(data) |
| 664 | ! |
if (length(errors) > 0) {
|
| 665 | ! |
stop( |
| 666 | ! |
"Check the columns of your data, the following are missing:\n", |
| 667 | ! |
paste(errors, sep = "\n", collapse = "\n") |
| 668 |
) |
|
| 669 |
} |
|
| 670 |
# datestart and dateend need to be date classes so leading zeros are present |
|
| 671 |
# but writing and reading from csv file removes the classes so they must be |
|
| 672 |
# enforced here |
|
| 673 |
# e.g., 0004-01-01 for January 01 0004 |
|
| 674 | ! |
date_formats <- c("%Y-%m-%d")
|
| 675 | ! |
data[["datestart"]] <- as.Date(data[["datestart"]], tryFormats = date_formats) |
| 676 | ! |
data[["dateend"]] <- as.Date(data[["dateend"]], tryFormats = date_formats) |
| 677 | ||
| 678 |
# Get the earliest and latest year formatted as a string of 4 integers |
|
| 679 | ! |
start_year <- as.integer(format( |
| 680 | ! |
as.Date(min(data[["datestart"]], na.rm = TRUE), tryFormats = date_formats), |
| 681 | ! |
"%Y" |
| 682 |
)) |
|
| 683 | ! |
end_year <- as.integer(format( |
| 684 | ! |
as.Date(max(data[["dateend"]], na.rm = TRUE), tryFormats = date_formats), |
| 685 | ! |
"%Y" |
| 686 |
)) |
|
| 687 | ! |
n_years <- as.integer(end_year - start_year + 1) |
| 688 | ! |
years <- start_year:end_year |
| 689 | ||
| 690 |
# Get the fleets represented in the data |
|
| 691 | ! |
fleets <- unique(data[["name"]])[grep("fleet", unique(data[["name"]]))]
|
| 692 | ! |
fleets <- as.numeric( |
| 693 | ! |
unlist(lapply(strsplit(fleets, "fleet"), function(x) x[2])) |
| 694 |
) |
|
| 695 | ! |
n_fleets <- length(fleets) |
| 696 | ||
| 697 | ! |
if ("age" %in% colnames(data)) {
|
| 698 |
# Forced to use annual age bins because the model is on an annual time step |
|
| 699 |
# FUTURE: allow for different age bins rather than 1 year increment |
|
| 700 | ! |
ages <- min(data[["age"]], na.rm = TRUE):max(data[["age"]], na.rm = TRUE) |
| 701 |
} else {
|
|
| 702 | ! |
ages <- numeric() |
| 703 |
} |
|
| 704 | ! |
n_ages <- length(ages) |
| 705 | ||
| 706 | ! |
if ("length" %in% colnames(data)) {
|
| 707 | ! |
if (all(is.na(data[["length"]]))) {
|
| 708 | ! |
lengths <- numeric() |
| 709 |
} else {
|
|
| 710 | ! |
lengths <- sort(unique(data[["length"]])) |
| 711 | ! |
lengths <- lengths[!is.na(lengths)] |
| 712 |
} |
|
| 713 |
} else {
|
|
| 714 | ! |
lengths <- numeric() |
| 715 |
} |
|
| 716 | ! |
n_lengths <- length(lengths) |
| 717 | ||
| 718 |
# Work on filling in missing data with -999 and arrange in the correct |
|
| 719 |
# order so that getting information out with m_*() are correct. |
|
| 720 | ! |
formatted_data <- tibble::as_tibble(data) |> |
| 721 | ! |
dplyr::mutate( |
| 722 | ! |
year = as.numeric(format(datestart, "%Y")) |
| 723 |
) |
|
| 724 | ! |
missing_time_series <- create_missing_data( |
| 725 | ! |
data = formatted_data, |
| 726 | ! |
years = years |
| 727 |
) |
|
| 728 | ! |
if ("age" %in% colnames(formatted_data)) {
|
| 729 | ! |
missing_ages <- create_missing_data( |
| 730 | ! |
data = formatted_data, |
| 731 | ! |
bins = ages, |
| 732 | ! |
years = years, |
| 733 | ! |
column = age, |
| 734 | ! |
types = c("weight-at-age", "age")
|
| 735 |
) |
|
| 736 |
} else {
|
|
| 737 | ! |
missing_ages <- missing_time_series[0, ] |
| 738 |
} |
|
| 739 | ! |
if ("length" %in% colnames(formatted_data)) {
|
| 740 | ! |
missing_lengths <- create_missing_data( |
| 741 | ! |
data = formatted_data, |
| 742 | ! |
bins = lengths, |
| 743 | ! |
years = years, |
| 744 | ! |
column = length, |
| 745 | ! |
types = "length" |
| 746 |
) |
|
| 747 |
} else {
|
|
| 748 | ! |
missing_lengths <- missing_time_series[0, ] |
| 749 |
} |
|
| 750 | ! |
if ("age-to-length-conversion" %in% formatted_data[["type"]]) {
|
| 751 |
# Must do this by hand because it is across two dimensions |
|
| 752 | ! |
temp_age_to_length_data <- formatted_data |> |
| 753 | ! |
dplyr::group_by(type, name) |
| 754 | ! |
missing_age_to_length <- temp_age_to_length_data |> |
| 755 | ! |
dplyr::group_by(type, name) |> |
| 756 | ! |
dplyr::filter(type %in% "age-to-length-conversion") |> |
| 757 | ! |
tidyr::expand(unit, year = years, age = ages, length = lengths) |> |
| 758 | ! |
dplyr::anti_join( |
| 759 | ! |
y = dplyr::select( |
| 760 | ! |
temp_age_to_length_data, |
| 761 | ! |
type, name, unit, year, age, length |
| 762 |
), |
|
| 763 | ! |
by = dplyr::join_by(type, name, unit, year, age, length) |
| 764 |
) |> |
|
| 765 | ! |
dplyr::mutate( |
| 766 | ! |
value = 0, |
| 767 | ! |
datestart = as.Date(sprintf("%04.0f-01-01", year), date_formats),
|
| 768 | ! |
dateend = as.Date(sprintf("%04.0f-12-31", year), date_formats)
|
| 769 |
) |> |
|
| 770 | ! |
dplyr::ungroup() |
| 771 |
} else {
|
|
| 772 | ! |
missing_age_to_length <- missing_time_series[0, ] |
| 773 |
} |
|
| 774 | ! |
missing_data <- dplyr::bind_rows( |
| 775 | ! |
missing_time_series, |
| 776 | ! |
missing_ages, |
| 777 | ! |
missing_lengths, |
| 778 | ! |
missing_age_to_length |
| 779 |
) |
|
| 780 | ! |
sort_order <- intersect( |
| 781 | ! |
c("name", "type", "datestart", "age", "length"),
|
| 782 | ! |
colnames(formatted_data) |
| 783 |
) |
|
| 784 | ! |
complete_data <- dplyr::full_join( |
| 785 | ! |
formatted_data, |
| 786 | ! |
missing_data, |
| 787 | ! |
by = colnames(missing_data) |
| 788 |
) |> |
|
| 789 | ! |
dplyr::arrange(!!!rlang::parse_exprs(sort_order)) |
| 790 | ||
| 791 |
# Fill the empty data frames with data extracted from the data file |
|
| 792 | ! |
out <- methods::new("FIMSFrame",
|
| 793 | ! |
data = complete_data, |
| 794 | ! |
fleets = fleets, |
| 795 | ! |
n_years = n_years, |
| 796 | ! |
start_year = start_year, |
| 797 | ! |
end_year = end_year, |
| 798 | ! |
ages = ages, |
| 799 | ! |
n_ages = n_ages, |
| 800 | ! |
lengths = lengths, |
| 801 | ! |
n_lengths = n_lengths |
| 802 |
) |
|
| 803 | ! |
return(out) |
| 804 |
} |
|
| 805 | ||
| 806 |
# Unexported functions ---- |
|
| 807 |
create_missing_data <- function( |
|
| 808 |
data, |
|
| 809 |
bins, |
|
| 810 |
years, |
|
| 811 |
column, |
|
| 812 |
types = c("landings", "index")
|
|
| 813 |
) {
|
|
| 814 | ! |
use_this_data <- data |> |
| 815 | ! |
dplyr::group_by(type, name) |
| 816 | ! |
out_data <- if (missing(bins)) {
|
| 817 |
# This only pertains to annual data without bins |
|
| 818 | ! |
use_this_data |> |
| 819 | ! |
dplyr::filter(type %in% types) |> |
| 820 | ! |
tidyr::expand(unit, year = years) |> |
| 821 | ! |
dplyr::anti_join( |
| 822 | ! |
y = dplyr::select(use_this_data, type, name, unit, year), |
| 823 | ! |
by = dplyr::join_by(type, name, unit, year) |
| 824 |
) |
|
| 825 |
} else {
|
|
| 826 | ! |
use_this_data |> |
| 827 | ! |
dplyr::group_by(type, name) |> |
| 828 | ! |
dplyr::filter(type %in% types) |> |
| 829 | ! |
tidyr::expand(unit, year = years, {{ column }} := bins) |>
|
| 830 | ! |
dplyr::anti_join( |
| 831 | ! |
y = dplyr::select(use_this_data, type, name, unit, year, {{ column }}),
|
| 832 | ! |
by = dplyr::join_by(type, name, unit, year, {{ column }})
|
| 833 |
) |
|
| 834 |
} |
|
| 835 | ! |
date_formats <- c("%Y-%m-%d")
|
| 836 | ! |
out_data |> |
| 837 | ! |
dplyr::mutate( |
| 838 | ! |
value = -999, |
| 839 | ! |
datestart = as.Date(sprintf("%04.0f-01-01", year), date_formats),
|
| 840 | ! |
dateend = as.Date(sprintf("%04.0f-12-31", year), date_formats)
|
| 841 |
) |> |
|
| 842 | ! |
dplyr::ungroup() |
| 843 |
} |
| 1 |
# TODO: Document the names/items in each list that are returned |
|
| 2 |
#' Create default parameters for a FIMS model |
|
| 3 |
#' |
|
| 4 |
#' @description |
|
| 5 |
#' This function generates default parameter settings for a Fisheries |
|
| 6 |
#' Integrated Modeling System (FIMS) model, including recruitment, growth, |
|
| 7 |
#' maturity, population, and fleet configurations. It applies default |
|
| 8 |
#' configurations when specific module settings are not provided by the user. |
|
| 9 |
#' @param data An S4 object. FIMS input data. |
|
| 10 |
#' @param fleets A named list of settings for the fleet module. Each element of |
|
| 11 |
#' the list should specify a fleet's selectivity form and settings for the |
|
| 12 |
#' data distribution. If this argument is missing, default values will be |
|
| 13 |
#' applied for each fleet that is not specified but present in `data` based |
|
| 14 |
#' on the types of information present for that fleet. |
|
| 15 |
#' @param recruitment A list specifying the settings for the recruitment |
|
| 16 |
#' module. The default is a Beverton--Holt recruitment relationship with |
|
| 17 |
#' log-normal recruitment deviations. |
|
| 18 |
#' @param growth A list specifying the settings for the growth module. The |
|
| 19 |
#' default is `"EWAAgrowth"`. |
|
| 20 |
#' @param maturity A list specifying the settings for the maturity module. The |
|
| 21 |
#' default is `"LogisticMaturity"`. |
|
| 22 |
#' @return |
|
| 23 |
#' A list containing the following two entries: |
|
| 24 |
#' \describe{
|
|
| 25 |
#' \item{\code{parameters}:}{A list of parameter inputs for the FIMS
|
|
| 26 |
#' model.} |
|
| 27 |
#' \item{\code{modules}:}{A list of modules with default or user-provided
|
|
| 28 |
#' settings.} |
|
| 29 |
#' } |
|
| 30 |
#' @export |
|
| 31 |
#' @seealso |
|
| 32 |
#' * [update_parameters()] |
|
| 33 |
#' @examples |
|
| 34 |
#' \dontrun{
|
|
| 35 |
#' data("data1")
|
|
| 36 |
#' fims_frame <- FIMSFrame(data1) |
|
| 37 |
#' fleet1 <- survey1 <- list( |
|
| 38 |
#' selectivity = list(form = "LogisticSelectivity"), |
|
| 39 |
#' data_distribution = c( |
|
| 40 |
#' Index = "DlnormDistribution", |
|
| 41 |
#' AgeComp = "DmultinomDistribution" |
|
| 42 |
#' ) |
|
| 43 |
#' ) |
|
| 44 |
#' fleet2 <- list( |
|
| 45 |
#' selectivity = list(form = "DoubleLogisticSelectivity"), |
|
| 46 |
#' data_distribution = c( |
|
| 47 |
#' Index = "DlnormDistribution", |
|
| 48 |
#' AgeComp = "DmultinomDistribution", |
|
| 49 |
#' LengthComp = "DmultinomDistribution" |
|
| 50 |
#' ) |
|
| 51 |
#' ) |
|
| 52 |
#' default_parameters <- fims_frame |> |
|
| 53 |
#' create_default_parameters( |
|
| 54 |
#' fleets = list(fleet1 = fleet1, fleet2 = fleet2, survey1 = survey1), |
|
| 55 |
#' recruitment = list( |
|
| 56 |
#' form = "BevertonHoltRecruitment", |
|
| 57 |
#' process_distribution = c(log_devs = "DnormDistribution") |
|
| 58 |
#' ), |
|
| 59 |
#' growth = list(form = "EWAAgrowth"), |
|
| 60 |
#' maturity = list(form = "LogisticMaturity") |
|
| 61 |
#' ) |
|
| 62 |
#' } |
|
| 63 |
create_default_parameters <- function( |
|
| 64 |
data, |
|
| 65 |
fleets, |
|
| 66 |
recruitment = list( |
|
| 67 |
form = "BevertonHoltRecruitment", |
|
| 68 |
process_distribution = c(log_devs = "DnormDistribution") |
|
| 69 |
), |
|
| 70 |
# TODO: Rename EWAAgrowth to not use an acronym |
|
| 71 |
growth = list(form = "EWAAgrowth"), |
|
| 72 |
maturity = list(form = "LogisticMaturity") |
|
| 73 |
) {
|
|
| 74 |
# FIXME: use default values if there are no fleets info passed into the |
|
| 75 |
# function or a fleet is not present but it has data? Maybe we don't want the |
|
| 76 |
# latter because it could be that we want to drop a fleet from a model but we |
|
| 77 |
# don't want to alter the data? |
|
| 78 | ||
| 79 |
# Check for fleet names that do not match those in the data object |
|
| 80 | ! |
fleet_names <- names(fleets) |
| 81 | ! |
mismatch_fleet_names <- fleet_names[ |
| 82 | ! |
!(fleet_names %in% unique(dplyr::pull(get_data(data), name))) |
| 83 |
] |
|
| 84 | ! |
if (length(mismatch_fleet_names) > 0) {
|
| 85 | ! |
cli::cli_abort(c( |
| 86 | ! |
"i" = "The name of the fleets for selectivity settings must match |
| 87 | ! |
the fleet names present in the {.var data}.",
|
| 88 | ! |
"x" = "The following {length(mismatch_fleet_names)} fleet name{?s}
|
| 89 | ! |
{?is/are} missing from the data: {mismatch_fleet_names}."
|
| 90 |
)) |
|
| 91 |
} |
|
| 92 | ||
| 93 |
# Create module list |
|
| 94 | ! |
module_list <- list( |
| 95 | ! |
fleets = fleets, |
| 96 | ! |
recruitment = recruitment, |
| 97 | ! |
growth = growth, |
| 98 | ! |
maturity = maturity |
| 99 |
) |
|
| 100 | ||
| 101 |
# Create fleet parameters |
|
| 102 | ! |
fleet_temp <- list() |
| 103 | ! |
for (i in 1:length(fleets)) {
|
| 104 | ! |
fleet_temp <- c( |
| 105 | ! |
fleet_temp, |
| 106 | ! |
create_default_fleet( |
| 107 | ! |
fleets = fleets, |
| 108 | ! |
fleet_name = names(fleets)[i], |
| 109 | ! |
data = data |
| 110 |
) |
|
| 111 |
) |
|
| 112 |
} |
|
| 113 | ||
| 114 |
# Create recruitment parameters |
|
| 115 | ! |
recruitment_temp <- create_default_recruitment( |
| 116 | ! |
recruitment = recruitment, |
| 117 | ! |
data = data, |
| 118 | ! |
input_type = recruitment[["form"]] |
| 119 |
) |
|
| 120 | ||
| 121 |
# Create maturity parameters |
|
| 122 | ! |
maturity_temp <- create_default_maturity(form = maturity$form) |
| 123 | ||
| 124 |
# Create population parameters |
|
| 125 |
# Handle population parameters based on recruitment form |
|
| 126 | ! |
if (recruitment[["form"]] == "BevertonHoltRecruitment") {
|
| 127 | ! |
log_rzero <- recruitment_temp[["recruitment"]][[ |
| 128 | ! |
paste0(recruitment[["form"]], ".log_rzero.value") |
| 129 |
]] |
|
| 130 |
} |
|
| 131 | ! |
population_temp <- create_default_Population(data, log_rzero) |
| 132 | ||
| 133 |
# Compile output |
|
| 134 | ! |
output <- list( |
| 135 | ! |
parameters = c( |
| 136 | ! |
fleet_temp, |
| 137 | ! |
recruitment_temp, |
| 138 | ! |
maturity_temp, |
| 139 | ! |
population_temp |
| 140 |
), |
|
| 141 | ! |
modules = module_list |
| 142 |
) |
|
| 143 | ! |
return(output) |
| 144 |
} |
|
| 145 | ||
| 146 |
#' Create default population parameters |
|
| 147 |
#' |
|
| 148 |
#' @description |
|
| 149 |
#' This function sets up default parameters for a population module. |
|
| 150 |
#' @details |
|
| 151 |
#' The natural log of the initial numbers at age (`log_init_naa.value`) is set based on |
|
| 152 |
#' unexploited recruitment and natural mortality. |
|
| 153 |
#' @param data An S4 object. FIMS input data. |
|
| 154 |
#' @param log_rzero A numeric value representing the natural log of unexploited |
|
| 155 |
#' recruitment. |
|
| 156 |
#' @return |
|
| 157 |
#' A named list of default population parameters, including initial numbers at |
|
| 158 |
#' age and natural mortality rate. |
|
| 159 |
#' @noRd |
|
| 160 |
create_default_Population <- function(data, log_rzero) {
|
|
| 161 |
# Input checks |
|
| 162 |
# Check if log_rzero is numeric |
|
| 163 | ! |
if (!is.numeric(log_rzero) || length(log_rzero) != 1) {
|
| 164 | ! |
local_bullets <- c( |
| 165 | ! |
"i" = "{.var log_rzero} argument must be a single numeric value.",
|
| 166 | ! |
"x" = "{.var log_rzero} has a length of {length(log_rzero)}.",
|
| 167 | ! |
"x" = "{.var log_rzero} is of the class {class(log_rzero)}."
|
| 168 |
) |
|
| 169 | ! |
names(local_bullets)[2] <- ifelse(length(log_rzero) > 1, "x", "i") |
| 170 | ! |
names(local_bullets)[3] <- ifelse(inherits(log_rzero, "numeric"), "i", "x") |
| 171 | ! |
cli::cli_abort(local_bullets) |
| 172 |
} |
|
| 173 | ||
| 174 |
# Extract necessary values from data |
|
| 175 | ! |
n_years <- get_n_years(data) |
| 176 | ! |
n_ages <- get_n_ages(data) |
| 177 | ||
| 178 |
# Set natural mortality rate |
|
| 179 | ! |
M_value <- 0.2 |
| 180 | ||
| 181 |
# Calculate initial numbers at age based on log_rzero and M_value |
|
| 182 | ! |
init_naa <- exp(log_rzero) * exp(-(get_ages(data) - 1) * M_value) |
| 183 | ! |
init_naa[n_ages] <- init_naa[n_ages] / M_value # sum of infinite series |
| 184 | ||
| 185 |
# Create a list of default parameters |
|
| 186 | ! |
default <- list( |
| 187 | ! |
log_M.value = rep(log(M_value), n_years * n_ages), |
| 188 | ! |
log_M.estimated = FALSE, |
| 189 | ! |
log_init_naa.value = log(init_naa), |
| 190 | ! |
log_init_naa.estimated = TRUE |
| 191 |
) |
|
| 192 | ||
| 193 |
# Name the list elements |
|
| 194 | ! |
names(default) <- paste0("Population.", names(default))
|
| 195 |
# Wrap the default parameters in a population list for output |
|
| 196 | ! |
population_list <- list(default) |
| 197 | ! |
names(population_list) <- "population" |
| 198 | ! |
return(population_list) |
| 199 |
} |
|
| 200 | ||
| 201 |
#' Create default logistic parameters |
|
| 202 |
#' |
|
| 203 |
#' @description |
|
| 204 |
#' This function sets up default parameters for a logistic function. There are |
|
| 205 |
#' two specified parameters, the inflection point and slope. |
|
| 206 |
#' @return |
|
| 207 |
#' A list containing the default logistic parameters, with inflection_point and |
|
| 208 |
#' slope values and their estimation status. |
|
| 209 |
#' @noRd |
|
| 210 |
create_default_Logistic <- function() {
|
|
| 211 | ! |
default <- list( |
| 212 | ! |
inflection_point.value = 2, |
| 213 | ! |
inflection_point.estimated = TRUE, |
| 214 | ! |
slope.value = 1, |
| 215 | ! |
slope.estimated = TRUE |
| 216 |
) |
|
| 217 | ! |
return(default) |
| 218 |
} |
|
| 219 | ||
| 220 |
#' Create default double logistic parameters |
|
| 221 |
#' |
|
| 222 |
#' @description |
|
| 223 |
#' This function sets up default parameters for a double logistic function. |
|
| 224 |
#' There four specified parameters, two for the ascending and two for the |
|
| 225 |
#' descending inflection points and slopes. |
|
| 226 |
#' @return |
|
| 227 |
#' A list containing the default double logistic parameters, |
|
| 228 |
#' inflection_point_asc, slope_asc, inflection_point_desc, and slope_desc |
|
| 229 |
#' values and their estimation status. |
|
| 230 |
#' @noRd |
|
| 231 |
create_default_DoubleLogistic <- function() {
|
|
| 232 | ! |
logistic_defaults <- create_default_Logistic() |
| 233 | ! |
default <- structure( |
| 234 | ! |
rep(logistic_defaults, 2), |
| 235 | ! |
names = c( |
| 236 | ! |
gsub("\\.", "_asc.", names(logistic_defaults)),
|
| 237 | ! |
gsub("\\.", "_desc.", names(logistic_defaults))
|
| 238 |
) |
|
| 239 |
) |
|
| 240 |
# TODO: Determine if this should really be 4? |
|
| 241 | ! |
default[["inflection_point_desc.value"]] <- 4 |
| 242 | ||
| 243 | ! |
return(default) |
| 244 |
} |
|
| 245 | ||
| 246 |
#' Create default selectivity parameters |
|
| 247 |
#' |
|
| 248 |
#' @description |
|
| 249 |
#' This function sets up default parameters for a selectivity module. |
|
| 250 |
#' @param form A string specifying the desired form of selectivity. Allowable |
|
| 251 |
#' forms include `r toString(formals(create_default_selectivity)[["form"]])` |
|
| 252 |
#' and the default is |
|
| 253 |
#' `r toString(formals(create_default_selectivity)[["form"]][1])`. |
|
| 254 |
#' @return |
|
| 255 |
#' A list is returned with the default parameter values for the specified form |
|
| 256 |
#' of selectivity. |
|
| 257 |
#' @noRd |
|
| 258 |
create_default_selectivity <- function( |
|
| 259 |
form = c("LogisticSelectivity", "DoubleLogisticSelectivity")
|
|
| 260 |
) {
|
|
| 261 |
# Input checks |
|
| 262 | ! |
form <- rlang::arg_match(form) |
| 263 |
# NOTE: All new forms of selectivity must be placed in the vector of default |
|
| 264 |
# arguments for `form` and their methods but be placed below in the call to |
|
| 265 |
# `switch` |
|
| 266 | ! |
default <- switch(form, |
| 267 | ! |
"LogisticSelectivity" = create_default_Logistic(), |
| 268 | ! |
"DoubleLogisticSelectivity" = create_default_DoubleLogistic() |
| 269 |
) |
|
| 270 | ! |
names(default) <- paste0(form, ".", names(default)) |
| 271 | ||
| 272 | ! |
return(default) |
| 273 |
} |
|
| 274 | ||
| 275 |
#' Create default fleet parameters |
|
| 276 |
#' |
|
| 277 |
#' @description |
|
| 278 |
#' This function sets up default parameters for a fleet module. It compiles |
|
| 279 |
#' selectivity parameters along with distributions for each type of data that |
|
| 280 |
#' are present for the given fleet. |
|
| 281 |
#' |
|
| 282 |
#' @param fleets A list of fleet configurations. |
|
| 283 |
#' @param fleet_name A character. Name of the fleet. |
|
| 284 |
#' @param data An S4 object. FIMS input data. |
|
| 285 |
#' @return |
|
| 286 |
#' A list with default parameters for the fleet. |
|
| 287 |
#' @noRd |
|
| 288 |
create_default_fleet <- function(fleets, |
|
| 289 |
fleet_name, |
|
| 290 |
data) {
|
|
| 291 |
# Input checks |
|
| 292 | ! |
if (length(fleet_name) > 1) {
|
| 293 | ! |
cli::cli_abort(c( |
| 294 | ! |
"i" = "{.var fleet_name} should have a length of 1.",
|
| 295 | ! |
"x" = "{.var fleet_name} has a length of {length(fleet_name)}."
|
| 296 |
)) |
|
| 297 |
} |
|
| 298 | ! |
if (!inherits(fleet_name, "character")) {
|
| 299 | ! |
cli::cli_abort(c( |
| 300 | ! |
"i" = "{.var fleet_name} should be a string.",
|
| 301 | ! |
"x" = "{.var fleet_name} is a {class(fleet_name)}."
|
| 302 |
)) |
|
| 303 |
} |
|
| 304 | ! |
if (!fleet_name %in% names(fleets)) {
|
| 305 | ! |
cli::cli_abort(c( |
| 306 | ! |
"i" = "{.var fleet_name} should be present in the names of {.var fleets}.",
|
| 307 | ! |
"x" = "{.var {fleet_name}} is not in {names(fleets)}."
|
| 308 |
)) |
|
| 309 |
} |
|
| 310 | ||
| 311 |
# Create default selectivity parameters |
|
| 312 | ! |
selectivity_default <- create_default_selectivity( |
| 313 | ! |
form = fleets[[fleet_name]][["selectivity"]][["form"]] |
| 314 |
) |
|
| 315 | ||
| 316 |
# Get types of data for this fleet from the data object |
|
| 317 | ! |
data_types_present <- get_data(data) |> |
| 318 | ! |
dplyr::filter(name == fleet_name) |> |
| 319 | ! |
dplyr::pull(type) |> |
| 320 | ! |
unique() |
| 321 | ||
| 322 |
# Determine default fleet parameters based on types of data present |
|
| 323 |
# FIXME: allow for a fleet to have both landings and index data |
|
| 324 | ! |
process_default <- if ("landings" %in% data_types_present) {
|
| 325 | ! |
list( |
| 326 | ! |
log_Fmort.value = log(rep(0.00001, get_n_years(data))), |
| 327 | ! |
log_Fmort.estimated = TRUE |
| 328 |
) |
|
| 329 |
} else {
|
|
| 330 | ! |
list( |
| 331 | ! |
log_q.value = 0, |
| 332 | ! |
log_q.estimated = TRUE |
| 333 |
) |
|
| 334 |
} |
|
| 335 | ||
| 336 | ! |
names(process_default) <- paste0("Fleet.", names(process_default))
|
| 337 | ||
| 338 |
# Create index distribution defaults |
|
| 339 | ! |
index_distribution <- fleets[[fleet_name]][["data_distribution"]]["Index"] |
| 340 | ||
| 341 |
# FIXME: Will this work if both landings and index data are present? |
|
| 342 | ! |
index_uncertainty <- get_data(data) |> |
| 343 | ! |
dplyr::filter(name == fleet_name, type %in% c("landings", "index")) |>
|
| 344 | ! |
dplyr::arrange(dplyr::desc(type)) |> |
| 345 | ! |
dplyr::pull(uncertainty) |
| 346 | ||
| 347 | ! |
index_distribution_default <- switch(index_distribution, |
| 348 | ! |
"DnormDistribution" = create_default_DnormDistribution( |
| 349 | ! |
value = index_uncertainty, |
| 350 | ! |
input_type = "data", |
| 351 | ! |
data = data |
| 352 |
), |
|
| 353 | ! |
"DlnormDistribution" = create_default_DlnormDistribution( |
| 354 | ! |
value = index_uncertainty, |
| 355 | ! |
input_type = "data", |
| 356 | ! |
data = data |
| 357 |
) |
|
| 358 |
) |
|
| 359 | ! |
names(index_distribution_default) <- paste0( |
| 360 | ! |
index_distribution, |
| 361 |
".", |
|
| 362 | ! |
names(index_distribution_default) |
| 363 |
) |
|
| 364 | ||
| 365 |
# Compile all default parameters into a single list |
|
| 366 | ! |
default <- list(c( |
| 367 | ! |
selectivity_default, |
| 368 | ! |
process_default, |
| 369 | ! |
index_distribution_default |
| 370 |
)) |
|
| 371 | ||
| 372 | ! |
names(default) <- fleet_name |
| 373 | ! |
return(default) |
| 374 |
} |
|
| 375 | ||
| 376 |
#' Create default maturity parameters |
|
| 377 |
#' |
|
| 378 |
#' @description |
|
| 379 |
#' This function sets up default parameters for a maturity module. |
|
| 380 |
#' @param form A string specifying the form of maturity (e.g., |
|
| 381 |
#' `"LogisticMaturity"`). |
|
| 382 |
#' @return |
|
| 383 |
#' A list containing the default maturity parameters. |
|
| 384 |
#' @noRd |
|
| 385 |
create_default_maturity <- function(form = c("LogisticMaturity")) {
|
|
| 386 |
# Input checks |
|
| 387 | ! |
form <- rlang::arg_match(form) |
| 388 | ||
| 389 |
# NOTE: All new forms of maturity must be placed in the vector of default |
|
| 390 |
# arguments for `form` and their methods but be placed below in the call to |
|
| 391 |
# `switch` |
|
| 392 | ! |
default <- list( |
| 393 | ! |
"maturity" = switch(form, |
| 394 | ! |
"LogisticMaturity" = create_default_Logistic() |
| 395 |
) |
|
| 396 |
) |
|
| 397 | ! |
names(default[["maturity"]]) <- paste0(form, ".", names(default[["maturity"]])) |
| 398 | ||
| 399 | ! |
return(default) |
| 400 |
} |
|
| 401 | ||
| 402 |
#' Create default Beverton--Holt recruitment parameters |
|
| 403 |
#' |
|
| 404 |
#' @description |
|
| 405 |
#' This function sets up default parameters for a Beverton--Holt recruitment |
|
| 406 |
#' relationship. Parameters include the natural log of unfished recruitment, |
|
| 407 |
#' the logit transformation of the slope of the spawner-–recruitment curve to |
|
| 408 |
#' keep it between zero and one, and the time series of spawner-recruitment |
|
| 409 |
#' deviations on the natural log scale. |
|
| 410 |
#' @param data An S4 object. FIMS input data. |
|
| 411 |
#' @return |
|
| 412 |
#' A list containing default recruitment parameters. |
|
| 413 |
#' @noRd |
|
| 414 |
create_default_BevertonHoltRecruitment <- function(data) {
|
|
| 415 |
# Create default parameters for Beverton--Holt recruitment |
|
| 416 | ! |
default <- list( |
| 417 | ! |
log_rzero.value = log(1e+06), |
| 418 | ! |
log_rzero.estimated = TRUE, |
| 419 | ! |
logit_steep.value = -log(1.0 - 0.75) + log(0.75 - 0.2), |
| 420 | ! |
logit_steep.estimated = FALSE, |
| 421 | ! |
log_devs.value = rep(0.0, get_n_years(data) - 1), |
| 422 | ! |
log_devs.estimated = TRUE, |
| 423 | ! |
estimate_log_devs = TRUE |
| 424 |
) |
|
| 425 | ! |
return(default) |
| 426 |
} |
|
| 427 | ||
| 428 |
#' Create default DnormDistribution parameters |
|
| 429 |
#' |
|
| 430 |
#' @description |
|
| 431 |
#' This function sets up default parameters to calculate the density of a |
|
| 432 |
#' normal distribution, i.e., `DnormDistribution`, module. |
|
| 433 |
#' @param value A real number that is passed to `log_sd`. The default value is |
|
| 434 |
#' `0.1`. |
|
| 435 |
#' @param data An S4 object. FIMS input data. |
|
| 436 |
#' @param input_type A string specifying the input type. The available options |
|
| 437 |
#' are |
|
| 438 |
#' `r toString(formals(create_default_DnormDistribution)[["input_type"]])`. |
|
| 439 |
#' The default is |
|
| 440 |
#' `r toString(formals(create_default_DnormDistribution)[["input_type"]][1])`. |
|
| 441 |
#' @return |
|
| 442 |
#' A list of default parameters for DnormDistribution. |
|
| 443 |
#' @noRd |
|
| 444 |
create_default_DnormDistribution <- function( |
|
| 445 |
value = 0.1, |
|
| 446 |
data, |
|
| 447 |
input_type = c("data", "process")
|
|
| 448 |
) {
|
|
| 449 |
# Input checks |
|
| 450 | ! |
input_type <- rlang::arg_match(input_type) |
| 451 | ||
| 452 |
# Create default parameters |
|
| 453 | ! |
default <- list( |
| 454 | ! |
log_sd.value = value, |
| 455 | ! |
log_sd.estimated = FALSE |
| 456 |
) |
|
| 457 | ||
| 458 |
# If input_type is 'process', add additional parameters |
|
| 459 | ! |
if (input_type == "process") {
|
| 460 | ! |
default <- c( |
| 461 | ! |
default, |
| 462 | ! |
list( |
| 463 | ! |
x.value = rep(0, get_n_years(data)), |
| 464 | ! |
x.estimated = FALSE, |
| 465 | ! |
expected_values.value = rep(0, get_n_years(data)), |
| 466 | ! |
expected_values.estimated = FALSE |
| 467 |
) |
|
| 468 |
) |
|
| 469 |
} |
|
| 470 | ! |
return(default) |
| 471 |
} |
|
| 472 | ||
| 473 |
#' Create default DlnormDistribution parameters |
|
| 474 |
#' |
|
| 475 |
#' @description |
|
| 476 |
#' This function sets up default parameters to calculate the density of a |
|
| 477 |
#' log-normal distribution, i.e., `DlnormDistribution`, module. |
|
| 478 |
#' @param value Default value for `log_sd`. |
|
| 479 |
#' @param data An S4 object. FIMS input data. |
|
| 480 |
#' @param input_type A string specifying the input type. The available options |
|
| 481 |
#' are |
|
| 482 |
#' `r toString(formals(create_default_DlnormDistribution)[["input_type"]])`. |
|
| 483 |
#' The default is |
|
| 484 |
#' `r toString(formals(create_default_DlnormDistribution)[["input_type"]][1])`. |
|
| 485 |
#' @return |
|
| 486 |
#' A list of default parameters for DlnormDistribution. |
|
| 487 |
#' @noRd |
|
| 488 |
create_default_DlnormDistribution <- function( |
|
| 489 |
value = 0.1, |
|
| 490 |
data, |
|
| 491 |
input_type = c("data", "process")
|
|
| 492 |
) {
|
|
| 493 |
# Input checks |
|
| 494 |
# TODO: Determine if value can be a vector? |
|
| 495 | ! |
if (!is.numeric(value) || any(value <= 0, na.rm = TRUE)) {
|
| 496 | ! |
cli::cli_abort(c( |
| 497 | ! |
"i" = "Inputs to {.var value} must be positive and numeric.",
|
| 498 | ! |
"x" = "{.var value} is {.var {value}}."
|
| 499 |
)) |
|
| 500 |
} |
|
| 501 | ! |
input_type <- rlang::arg_match(input_type) |
| 502 | ||
| 503 |
# Create the default list with log standard deviation |
|
| 504 | ! |
default <- list( |
| 505 | ! |
log_sd.value = log(value), |
| 506 | ! |
log_sd.estimated = FALSE |
| 507 |
) |
|
| 508 | ||
| 509 |
# Add additional parameters if input_type is "process" |
|
| 510 | ! |
if (input_type == "process") {
|
| 511 | ! |
default <- c( |
| 512 | ! |
default, |
| 513 | ! |
list( |
| 514 | ! |
x.value = rep(0, get_n_years(data)), |
| 515 | ! |
x.estimated = FALSE, |
| 516 | ! |
expected_values.value = rep(0, get_n_years(data)), |
| 517 | ! |
expected_values.estimated = FALSE |
| 518 |
) |
|
| 519 |
) |
|
| 520 |
} |
|
| 521 | ! |
return(default) |
| 522 |
} |
|
| 523 | ||
| 524 |
#' Create default recruitment parameters |
|
| 525 |
#' |
|
| 526 |
#' @description |
|
| 527 |
#' This function sets up default parameters for a recruitment module. |
|
| 528 |
#' |
|
| 529 |
#' @param recruitment A list with recruitment details, including form and |
|
| 530 |
#' process distribution type. |
|
| 531 |
#' @param data An S4 object. FIMS input data. |
|
| 532 |
#' @param input_type A string specifying the type of recruitment you want to |
|
| 533 |
#' use. The available options are |
|
| 534 |
#' `r toString(formals(create_default_recruitment)[["input_type"]])`. The |
|
| 535 |
#' default is |
|
| 536 |
#' `r toString(formals(create_default_recruitment)[["input_type"]][1])`. |
|
| 537 |
#' @return |
|
| 538 |
#' A list with the default parameters for recruitment. |
|
| 539 |
#' @noRd |
|
| 540 |
create_default_recruitment <- function( |
|
| 541 |
recruitment, |
|
| 542 |
data, |
|
| 543 |
input_type = "BevertonHoltRecruitment" |
|
| 544 |
) {
|
|
| 545 |
# Input checks |
|
| 546 | ! |
if (!is.list(recruitment)) {
|
| 547 | ! |
cli::cli_abort(c( |
| 548 | ! |
"i" = "The {.var recruitment} argument must be a list.",
|
| 549 | ! |
"x" = "{.var recruitment} is a {class(recruitment)}."
|
| 550 |
)) |
|
| 551 |
} |
|
| 552 | ! |
form <- rlang::arg_match(input_type) |
| 553 |
# Create default parameters based on the recruitment form |
|
| 554 |
# NOTE: All new forms of recruitment must be placed in the vector of default |
|
| 555 |
# arguments for `form` and their methods but be placed below in the call to |
|
| 556 |
# `switch` |
|
| 557 | ! |
process_default <- switch(form, |
| 558 | ! |
"BevertonHoltRecruitment" = create_default_BevertonHoltRecruitment(data) |
| 559 |
) |
|
| 560 | ! |
names(process_default) <- paste0(form, ".", names(process_default)) |
| 561 | ||
| 562 |
# Create default distribution parameters based on the distribution type |
|
| 563 | ! |
distribution_input <- recruitment[["process_distribution"]] |
| 564 | ! |
distribution_default <- NULL |
| 565 | ! |
if (!is.null(distribution_input)) {
|
| 566 | ! |
distribution_default <- switch(distribution_input, |
| 567 | ! |
"DnormDistribution" = create_default_DnormDistribution( |
| 568 | ! |
data = data, |
| 569 | ! |
input_type = "process" |
| 570 |
) |
|
| 571 |
) |
|
| 572 | ! |
names(distribution_default) <- paste0( |
| 573 | ! |
distribution_input, |
| 574 |
".", |
|
| 575 | ! |
names(distribution_default) |
| 576 |
) |
|
| 577 |
} |
|
| 578 | ||
| 579 |
# Combine process and distribution defaults into a single list |
|
| 580 | ! |
default <- list(c(process_default, distribution_default)) |
| 581 | ! |
names(default) <- "recruitment" |
| 582 | ! |
return(default) |
| 583 |
} |
|
| 584 | ||
| 585 |
#' Update input parameters for a FIMS model |
|
| 586 |
#' |
|
| 587 |
#' @description |
|
| 588 |
#' This function updates the input parameters of a Fisheries Integrated |
|
| 589 |
#' Modeling System (FIMS) model. It allows users to modify specific parameters |
|
| 590 |
#' by providing new values, while retaining the existing modules information |
|
| 591 |
#' from the current input. |
|
| 592 |
#' @param current_parameters A list containing the current input parameters, including: |
|
| 593 |
#' \describe{
|
|
| 594 |
#' \item{\code{parameters}:}{A list of parameter inputs.}
|
|
| 595 |
#' \item{\code{modules}:}{A list of module names used in the model.}
|
|
| 596 |
#' } |
|
| 597 |
#' @param modified_parameters A named list representing new parameter values to update. |
|
| 598 |
#' @rdname create_default_parameters |
|
| 599 |
#' @return |
|
| 600 |
#' A list containing: |
|
| 601 |
#' \describe{
|
|
| 602 |
#' \item{parameters}{A list of updated parameter inputs that
|
|
| 603 |
#' includes any modifications made by the user.} |
|
| 604 |
#' \item{modules}{The unchanged list of module names from the current
|
|
| 605 |
#' input.} |
|
| 606 |
#' } |
|
| 607 |
#' @seealso |
|
| 608 |
#' * [create_default_parameters()] |
|
| 609 |
#' @export |
|
| 610 |
update_parameters <- function(current_parameters, modified_parameters) {
|
|
| 611 |
# Input checks |
|
| 612 |
# Check if current_parameters is a list with required components |
|
| 613 |
if ( |
|
| 614 | ! |
!is.list(current_parameters) || |
| 615 | ! |
!all(c("parameters", "modules") %in% names(current_parameters))
|
| 616 |
) {
|
|
| 617 | ! |
cli::cli_abort(c( |
| 618 | ! |
"i" = "{.var current_parameters} argument must be a list containing
|
| 619 | ! |
parameters and modules.", |
| 620 | ! |
"x" = "{.var current_parameters} is a {class(current_parameters)}."
|
| 621 |
)) |
|
| 622 |
} |
|
| 623 |
# Check if modified_parameters is a named list |
|
| 624 | ! |
if (!is.list(modified_parameters) || is.null(names(modified_parameters))) {
|
| 625 | ! |
cli::cli_abort(c( |
| 626 | ! |
"i" = "{.var modified_parameters} argument must be must be a named list.",
|
| 627 | ! |
"x" = "{.var modified_parameters} is a {class(modified_parameters)}."
|
| 628 |
)) |
|
| 629 |
} |
|
| 630 | ||
| 631 |
# Check if modified_parameters exists in current_parameters |
|
| 632 | ! |
missing_input <- setdiff( |
| 633 | ! |
names(modified_parameters), |
| 634 | ! |
names(current_parameters[["parameters"]]) |
| 635 |
) |
|
| 636 | ! |
if (length(missing_input) > 0) {
|
| 637 | ! |
cli::cli_abort(c( |
| 638 | ! |
"x" = "The following {length(missing_input)} input list{?s} from
|
| 639 | ! |
{.var modified_parameters} {?is/are} missing from
|
| 640 | ! |
{.var current_parameters}: {missing_input}."
|
| 641 |
)) |
|
| 642 |
} |
|
| 643 | ||
| 644 | ! |
wrong_input <- setdiff( |
| 645 | ! |
names(current_parameters[["parameters"]]), |
| 646 | ! |
names(modified_parameters) |
| 647 |
) |
|
| 648 | ! |
if (length(missing_input) > 0) {
|
| 649 | ! |
cli::cli_abort(c( |
| 650 | ! |
"x" = "The following {length(missing_input)} input list{?s} from
|
| 651 | ! |
{.var modified_parameters} {?is/are} missing from
|
| 652 | ! |
{.var current_parameters}: {missing_input}."
|
| 653 |
)) |
|
| 654 |
} |
|
| 655 | ||
| 656 | ! |
new_param_input <- current_parameters[["parameters"]] |
| 657 | ! |
module_names <- names(new_param_input) |
| 658 | ||
| 659 |
# Update parameters for each module based on modified_parameters |
|
| 660 | ! |
for (module_name in module_names) {
|
| 661 | ! |
if (module_name %in% names(modified_parameters)) {
|
| 662 | ! |
modified_params <- modified_parameters[[module_name]] |
| 663 | ! |
current_params <- new_param_input[[module_name]] |
| 664 | ||
| 665 | ! |
for (param_name in names(modified_params)) {
|
| 666 |
# Check if the parameter exists in current_parameters |
|
| 667 | ! |
if (!param_name %in% names(current_params)) {
|
| 668 | ! |
cli::cli_abort(c( |
| 669 | ! |
"x" = "{param_name} from {module_name} in {.var modified_parameters}
|
| 670 | ! |
does not exist in {.var current_parameters}."
|
| 671 |
)) |
|
| 672 |
} |
|
| 673 | ||
| 674 |
# Check if the length of the modified and current parameter match |
|
| 675 | ! |
length_modified_parameter <- length(modified_params[[param_name]]) |
| 676 | ! |
length_current_parameter <- length(current_params[[param_name]]) |
| 677 | ! |
if (!identical(length_modified_parameter, length_current_parameter)) {
|
| 678 | ! |
cli::cli_abort(c( |
| 679 | ! |
"x" = "The length of {.var {param_name}} from {module_name}
|
| 680 | ! |
does not match between {.var modified_parameters} and
|
| 681 | ! |
{.var current_parameters}.",
|
| 682 | ! |
"i" = "The parameter name of interest is {.var {param_name}}.",
|
| 683 | ! |
"i" = "The length of the modified parameter is |
| 684 | ! |
{length_modified_parameter}.",
|
| 685 | ! |
"i" = "The length of the current parameter is |
| 686 | ! |
{length_current_parameter}."
|
| 687 |
)) |
|
| 688 |
} |
|
| 689 | ||
| 690 |
# Check if the type of the modified and current parameter match |
|
| 691 | ! |
if (!identical( |
| 692 | ! |
typeof(modified_params[[param_name]]), |
| 693 | ! |
typeof(current_params[[param_name]]) |
| 694 |
)) {
|
|
| 695 | ! |
cli::cli_abort(c( |
| 696 | ! |
"x" = "The type of {param_name} from {module_name} does not match
|
| 697 | ! |
between {.var modified_parameters} and
|
| 698 | ! |
{.var current_parameters}."
|
| 699 |
)) |
|
| 700 |
} |
|
| 701 | ||
| 702 |
# Update the parameter if checks pass |
|
| 703 | ! |
current_params[[param_name]] <- modified_params[[param_name]] |
| 704 |
} |
|
| 705 | ||
| 706 |
# Assign the updated module parameters back to new_param_input |
|
| 707 | ! |
new_param_input[[module_name]] <- current_params |
| 708 |
} |
|
| 709 |
} |
|
| 710 |
# Create a new list for updated input |
|
| 711 | ! |
new_input <- list( |
| 712 | ! |
parameters = new_param_input, |
| 713 | ! |
modules = current_parameters$modules |
| 714 |
) |
|
| 715 | ! |
return(new_input) |
| 716 |
} |
| 1 |
#' Set up your local environment to run the google tests locally |
|
| 2 |
#' |
|
| 3 |
#' Intended for developers to set up their local environment prior to running |
|
| 4 |
#' the integration tests. |
|
| 5 |
#' |
|
| 6 |
#' @keywords gtest_helper |
|
| 7 |
#' @examples \dontrun{
|
|
| 8 |
#' setup_gtest() |
|
| 9 |
#' } |
|
| 10 |
#' @export |
|
| 11 |
setup_gtest <- function() {
|
|
| 12 |
# bind om_output and om_input locally to the function to avoid |
|
| 13 |
# R CMD Check note: no visible binding for global variable |
|
| 14 | ! |
om_output <- om_input <- NULL |
| 15 |
# loop over iterations within the model comparison project output |
|
| 16 |
# currently don't need, but may need once we need more than one file. |
|
| 17 | ! |
for (c_case in 0:2) {
|
| 18 | ! |
for (i_iter in 1) {
|
| 19 |
# read Rdata file into workspace |
|
| 20 |
# temporarily use a scenario from the model comparison project that is |
|
| 21 |
# not deterministic |
|
| 22 | ! |
github_dir <- paste0( |
| 23 | ! |
"https://github.com/Bai-Li-NOAA/", |
| 24 | ! |
"Age_Structured_Stock_Assessment_Model_Comparison/raw/master/", |
| 25 | ! |
"FIMS_integration_test_data/FIMS_C", |
| 26 | ! |
c_case, |
| 27 | ! |
"/output/OM/" |
| 28 |
) |
|
| 29 | ! |
Rdata_file <- paste0("OM", i_iter, ".RData") # e.g. OM1.Rdata
|
| 30 |
# this loads the file directly from github |
|
| 31 |
# (which was easier to figure out than downloading the Rdata first) |
|
| 32 | ! |
load(url(paste0(github_dir, Rdata_file))) |
| 33 |
# write json file |
|
| 34 | ! |
output_name <- paste0("C", c_case, "_om_output", i_iter, ".json")
|
| 35 | ! |
input_name <- paste0("C", c_case, "_om_input", i_iter, ".json")
|
| 36 | ! |
json_folder <- file.path( |
| 37 | ! |
"tests", |
| 38 | ! |
"integration", |
| 39 | ! |
"FIMS-deterministic-inputs" |
| 40 |
) |
|
| 41 | ! |
if (!dir.exists(json_folder)) {
|
| 42 | ! |
dir.create(json_folder) |
| 43 |
} |
|
| 44 | ! |
jsonlite::write_json( |
| 45 | ! |
x = om_output, |
| 46 | ! |
path = file.path(json_folder, output_name), |
| 47 | ! |
pretty = TRUE |
| 48 |
) |
|
| 49 | ! |
jsonlite::write_json( |
| 50 | ! |
x = om_input, |
| 51 | ! |
path = file.path(json_folder, input_name), |
| 52 | ! |
pretty = TRUE |
| 53 |
) |
|
| 54 |
} |
|
| 55 |
} |
|
| 56 | ||
| 57 | ! |
TRUE |
| 58 |
} |
|
| 59 | ||
| 60 |
#' Setup and run the google test suite |
|
| 61 |
#' |
|
| 62 |
#' Intended for developers to set up their local environment and run the google |
|
| 63 |
#' test suite from R. |
|
| 64 |
#' |
|
| 65 |
#' @inheritParams run_gtest |
|
| 66 |
#' |
|
| 67 |
#' @keywords gtest_helper |
|
| 68 |
#' @export |
|
| 69 |
setup_and_run_gtest <- function(...) {
|
|
| 70 | ! |
setup_gtest() |
| 71 | ! |
run_gtest(...) |
| 72 | ! |
TRUE |
| 73 |
} |
|
| 74 | ||
| 75 |
#' Run the google test suite |
|
| 76 |
#' |
|
| 77 |
#' Intended for developers to run the google test suite from R. |
|
| 78 |
#' |
|
| 79 |
#' @param ... Additional arguments to `ctest --test-dir build` such as |
|
| 80 |
#' `"--rerun-failed --output-on-failure"`. |
|
| 81 |
#' |
|
| 82 |
#' @keywords gtest_helper |
|
| 83 |
#' @export |
|
| 84 |
run_gtest <- function(...) {
|
|
| 85 | ! |
system("cmake -S . -B build -G Ninja")
|
| 86 | ! |
system("cmake --build build")
|
| 87 | ! |
system(paste("ctest --test-dir build", ...))
|
| 88 | ! |
TRUE |
| 89 |
} |
| 1 |
#' Should FIMS be verbose? |
|
| 2 |
#' |
|
| 3 |
#' Verbosity is set globally for FIMS using |
|
| 4 |
#' `options(rlib_message_verbosity = "quiet")` to stop the printing of messages |
|
| 5 |
#' from `cli::cli_inform()`. Using a global option allows for verbose to not |
|
| 6 |
#' have to be an argument to every function. All `cli::cli_abort()` messages are |
|
| 7 |
#' printed to the console no matter what the global option is set to. |
|
| 8 |
#' |
|
| 9 |
#' @return |
|
| 10 |
#' A logical is returned where `TRUE` ensures messages from `cli::cli_inform()` |
|
| 11 |
#' are printed to the console. |
|
| 12 |
#' |
|
| 13 |
#' @examples |
|
| 14 |
#' # function is not exported |
|
| 15 |
#' \dontrun{
|
|
| 16 |
#' FIMS:::is_fims_verbose() |
|
| 17 |
#' } |
|
| 18 |
is_fims_verbose <- function() {
|
|
| 19 | ! |
verbose_option <- getOption("rlib_message_verbosity", default = "default")
|
| 20 | ! |
verbose_boolean <- ifelse( |
| 21 | ! |
verbose_option %in% c("default", "verbose"),
|
| 22 | ! |
TRUE, |
| 23 | ! |
FALSE |
| 24 |
) |
|
| 25 | ! |
return(verbose_boolean) |
| 26 |
} |
| 1 |
/** |
|
| 2 |
* @file fims_math.hpp |
|
| 3 |
* @brief TODO: provide a brief description. |
|
| 4 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 5 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 6 |
* folder for reuse information. |
|
| 7 |
*/ |
|
| 8 |
#ifndef FIMS_MATH_HPP |
|
| 9 |
#define FIMS_MATH_HPP |
|
| 10 | ||
| 11 |
// note: this is modeling platform specific, must be controlled by |
|
| 12 |
// preprocessing macros |
|
| 13 |
#include <cmath> |
|
| 14 |
#include <random> |
|
| 15 |
#include <sstream> |
|
| 16 | ||
| 17 |
#include "../interface/interface.hpp" |
|
| 18 |
#include "fims_vector.hpp" |
|
| 19 | ||
| 20 |
namespace fims_math {
|
|
| 21 |
#ifdef STD_LIB |
|
| 22 | ||
| 23 |
/** |
|
| 24 |
* @brief The exponential function. |
|
| 25 |
* |
|
| 26 |
* @param x value to exponentiate. Please use fims_math::exp<double>(x) if x is |
|
| 27 |
* an integer. |
|
| 28 |
* @return the exponentiated value |
|
| 29 |
*/ |
|
| 30 |
template <class Type> |
|
| 31 | 51191x |
inline const Type exp(const Type &x) {
|
| 32 | 51191x |
return std::exp(x); |
| 33 |
} |
|
| 34 | ||
| 35 |
/** |
|
| 36 |
* @brief The natural log function (base e) |
|
| 37 |
* @param x the value to take the log of. Please use fims_math::log<double>(x) |
|
| 38 |
* if x is an integer. |
|
| 39 |
* @return |
|
| 40 |
*/ |
|
| 41 |
template <class Type> |
|
| 42 | 412x |
inline const Type log(const Type &x) {
|
| 43 | 412x |
return std::log(x); |
| 44 |
} |
|
| 45 | ||
| 46 |
template <class Type> |
|
| 47 |
inline const Type cos(const Type &x) {
|
|
| 48 |
return std::cos(x); |
|
| 49 |
} |
|
| 50 | ||
| 51 |
template <class Type> |
|
| 52 | 54x |
inline const Type sqrt(const Type &x) {
|
| 53 | 54x |
return std::sqrt(x); |
| 54 |
} |
|
| 55 | ||
| 56 |
template <class Type> |
|
| 57 |
inline const Type pow(const Type &x, const Type &y) {
|
|
| 58 |
return std::pow(x, y); |
|
| 59 |
} |
|
| 60 |
#endif |
|
| 61 | ||
| 62 |
#ifdef TMB_MODEL |
|
| 63 | ||
| 64 |
/** |
|
| 65 |
* @brief The exponential function. |
|
| 66 |
* The code cannot be tested using the compilation flag |
|
| 67 |
* -DTMB_MODEL through CMake and Google Test |
|
| 68 |
* @param x value to exponentiate. Please use fims_math::exp<double>(x) if x is |
|
| 69 |
* an integer. |
|
| 70 |
* @return the exponentiated value |
|
| 71 |
*/ |
|
| 72 |
template <class Type> |
|
| 73 | ! |
inline const Type exp(const Type &x) {
|
| 74 |
using ::exp; |
|
| 75 | ! |
return exp(x); |
| 76 |
} |
|
| 77 | ||
| 78 |
template <> |
|
| 79 | ! |
inline const double exp(const double &x) {
|
| 80 | ! |
return std::exp(x); |
| 81 |
} |
|
| 82 | ||
| 83 |
/** |
|
| 84 |
* @brief The natural log function (base e) |
|
| 85 |
* The code cannot be tested using the compilation flag |
|
| 86 |
* -DTMB_MODEL through CMake and Google Test. |
|
| 87 |
* @param x the value to take the log of. Please use fims_math::log<double>(x) |
|
| 88 |
* if x is an integer. |
|
| 89 |
* @return The natural log of the value. |
|
| 90 |
*/ |
|
| 91 |
template <class Type> |
|
| 92 |
inline const Type log(const Type &x) {
|
|
| 93 |
return log(x); |
|
| 94 |
} |
|
| 95 | ||
| 96 |
template <> |
|
| 97 |
inline const double log(const double &x) {
|
|
| 98 |
return std::log(x); |
|
| 99 |
} |
|
| 100 | ||
| 101 |
template <class Type> |
|
| 102 |
inline const Type cos(const Type &x) {
|
|
| 103 |
return cos(x); |
|
| 104 |
} |
|
| 105 | ||
| 106 |
template <> |
|
| 107 |
inline const double cos(const double &x) {
|
|
| 108 |
return std::cos(x); |
|
| 109 |
} |
|
| 110 | ||
| 111 |
template <class Type> |
|
| 112 |
inline const Type sqrt(const Type &x) {
|
|
| 113 |
return sqrt(x); |
|
| 114 |
} |
|
| 115 | ||
| 116 |
template <> |
|
| 117 |
inline const double sqrt(const double &x) {
|
|
| 118 |
return std::sqrt(x); |
|
| 119 |
} |
|
| 120 | ||
| 121 |
template <class Type> |
|
| 122 |
inline const Type pow(const Type &x, const Type &y) {
|
|
| 123 |
return pow(x, y); |
|
| 124 |
} |
|
| 125 | ||
| 126 |
template <> |
|
| 127 |
inline const double pow(const double &x, const double &y) {
|
|
| 128 |
return std::pow(x, y); |
|
| 129 |
} |
|
| 130 | ||
| 131 |
#endif |
|
| 132 | ||
| 133 |
/** |
|
| 134 |
* @brief The general logistic function |
|
| 135 |
* |
|
| 136 |
* \f$ \frac{1.0}{ 1.0 + exp(-1.0 * slope (x - inflection_point))} \f$
|
|
| 137 |
* |
|
| 138 |
* @param inflection_point the inflection point of the logistic function |
|
| 139 |
* @param slope the slope of the logistic function |
|
| 140 |
* @param x the index the logistic function should be evaluated at |
|
| 141 |
* @return |
|
| 142 |
*/ |
|
| 143 |
template <class Type> |
|
| 144 | 12768x |
inline const Type logistic(const Type &inflection_point, const Type &slope, |
| 145 |
const Type &x) {
|
|
| 146 | 12768x |
return (1.0) / (1.0 + exp(-1.0 * slope * (x - inflection_point))); |
| 147 |
} |
|
| 148 | ||
| 149 |
/** |
|
| 150 |
* @brief A logit function for bounding of parameters |
|
| 151 |
* |
|
| 152 |
* \f$ -\mathrm{log}(b-x) + \mathrm{log}(x-a) \f$
|
|
| 153 |
* @param a lower bound |
|
| 154 |
* @param b upper bound |
|
| 155 |
* @param x the parameter in bounded space |
|
| 156 |
* @return the parameter in real space |
|
| 157 |
* |
|
| 158 |
*/ |
|
| 159 |
template <class Type> |
|
| 160 | 55x |
inline const Type logit(const Type &a, const Type &b, const Type &x) {
|
| 161 | 55x |
return -fims_math::log(b - x) + fims_math::log(x - a); |
| 162 |
} |
|
| 163 | ||
| 164 |
/** |
|
| 165 |
* @brief An inverse logit function for bounding of parameters |
|
| 166 |
* |
|
| 167 |
* \f$ a+\frac{b-a}{1+\mathrm{exp}(-\mathrm{logit}(x))}\f$
|
|
| 168 |
* @param a lower bound |
|
| 169 |
* @param b upper bound |
|
| 170 |
* @param logit_x the parameter in real space |
|
| 171 |
* @return the parameter in bounded space |
|
| 172 |
* |
|
| 173 |
*/ |
|
| 174 |
template <class Type> |
|
| 175 | 150x |
inline const Type inv_logit(const Type &a, const Type &b, const Type &logit_x) {
|
| 176 | 150x |
return a + (b - a) / (1.0 + fims_math::exp(-logit_x)); |
| 177 |
} |
|
| 178 | ||
| 179 |
/** |
|
| 180 |
* @brief The general double logistic function |
|
| 181 |
* |
|
| 182 |
* \f$ \frac{1.0}{ 1.0 + exp(-1.0 * slope_{asc} (x - inflection_point_{asc}))}
|
|
| 183 |
* \left(1-\frac{1.0}{ 1.0 + exp(-1.0 * slope_{desc} (x -
|
|
| 184 |
* inflection_point_{desc}))} \right)\f$
|
|
| 185 |
* |
|
| 186 |
* @param inflection_point_asc the inflection point of the ascending limb of the |
|
| 187 |
* double logistic function |
|
| 188 |
* @param slope_asc the slope of the ascending limb of the double logistic |
|
| 189 |
* function |
|
| 190 |
* @param inflection_point_desc the inflection point of the descending limb of |
|
| 191 |
* the double logistic function, where inflection_point_desc > |
|
| 192 |
* inflection_point_asc |
|
| 193 |
* @param slope_desc the slope of the descending limb of the double logistic |
|
| 194 |
* function |
|
| 195 |
* @param x the index the logistic function should be evaluated at |
|
| 196 |
* @return |
|
| 197 |
*/ |
|
| 198 | ||
| 199 |
template <class Type> |
|
| 200 | 12x |
inline const Type double_logistic(const Type &inflection_point_asc, |
| 201 |
const Type &slope_asc, |
|
| 202 |
const Type &inflection_point_desc, |
|
| 203 |
const Type &slope_desc, const Type &x) {
|
|
| 204 | 24x |
return (1.0) / (1.0 + exp(-1.0 * slope_asc * (x - inflection_point_asc))) * |
| 205 | 12x |
(1.0 - |
| 206 | 12x |
(1.0) / (1.0 + exp(-1.0 * slope_desc * (x - inflection_point_desc)))); |
| 207 |
} |
|
| 208 | ||
| 209 |
/** |
|
| 210 |
* |
|
| 211 |
* Used when x could evaluate to zero, which will result in a NaN for |
|
| 212 |
* derivative values. |
|
| 213 |
* |
|
| 214 |
* Evaluates: |
|
| 215 |
* |
|
| 216 |
* \f$ (x^2+C)^.5 \f$ |
|
| 217 |
* |
|
| 218 |
* @param x value to keep positive |
|
| 219 |
* @param C default = 1e-5 |
|
| 220 |
* @return |
|
| 221 |
*/ |
|
| 222 |
template <class Type> |
|
| 223 | 54x |
const Type ad_fabs(const Type &x, Type C = 1e-5) {
|
| 224 | 54x |
return sqrt((x * x) + C); |
| 225 |
} |
|
| 226 | ||
| 227 |
/** |
|
| 228 |
* |
|
| 229 |
* Returns the minimum between a and b in a continuous manner using: |
|
| 230 |
* |
|
| 231 |
* (a + b - fims_math::ad_fabs(a - b))*.5; |
|
| 232 |
* Reference: \ref fims_math::ad_fabs() |
|
| 233 |
* |
|
| 234 |
* This is an approximation with minimal error. |
|
| 235 |
* |
|
| 236 |
* @param a |
|
| 237 |
* @param b |
|
| 238 |
* @param C default = 1e-5 |
|
| 239 |
* @return |
|
| 240 |
*/ |
|
| 241 | ||
| 242 |
template <typename Type> |
|
| 243 | 18x |
inline const Type ad_min(const Type &a, const Type &b, Type C = 1e-5) {
|
| 244 | 18x |
return (a + b - fims_math::ad_fabs(a - b, C)) * 0.5; |
| 245 |
} |
|
| 246 | ||
| 247 |
/** |
|
| 248 |
* Returns the maximum between a and b in a continuous manner using: |
|
| 249 |
* |
|
| 250 |
* (a + b + fims_math::ad_fabs(a - b)) *.5; |
|
| 251 |
* Reference: \ref fims_math::ad_fabs() |
|
| 252 |
* This is an approximation with minimal error. |
|
| 253 |
* |
|
| 254 |
* @param a |
|
| 255 |
* @param b |
|
| 256 |
* @param C default = 1e-5 |
|
| 257 |
* @return |
|
| 258 |
*/ |
|
| 259 |
template <typename Type> |
|
| 260 | 18x |
inline const Type ad_max(const Type &a, const Type &b, Type C = 1e-5) {
|
| 261 | 18x |
return (a + b + fims_math::ad_fabs(a - b, C)) * static_cast<Type>(.5); |
| 262 |
} |
|
| 263 | ||
| 264 |
/** |
|
| 265 |
* Sum elements of a vector |
|
| 266 |
* |
|
| 267 |
* @brief |
|
| 268 |
* |
|
| 269 |
* @param v A vector of constants. |
|
| 270 |
* @return A single numeric value. |
|
| 271 |
*/ |
|
| 272 |
template<class T> |
|
| 273 |
T sum(const std::vector<T>& v) {
|
|
| 274 |
T ret = 0.0; |
|
| 275 |
for (int i = 0; i < v.size(); i++) {
|
|
| 276 |
ret += v[i]; |
|
| 277 |
} |
|
| 278 |
return ret; |
|
| 279 |
} |
|
| 280 | ||
| 281 |
/** |
|
| 282 |
* Sum elements of a vector |
|
| 283 |
* |
|
| 284 |
* @brief |
|
| 285 |
* |
|
| 286 |
* @param v A vector of constants. |
|
| 287 |
* @return A single numeric value. |
|
| 288 |
*/ |
|
| 289 |
template<class T> |
|
| 290 |
T sum(const fims::Vector<T>& v) {
|
|
| 291 |
T ret = 0.0; |
|
| 292 |
for (int i = 0; i < v.size(); i++) {
|
|
| 293 |
ret += v[i]; |
|
| 294 |
} |
|
| 295 |
return ret; |
|
| 296 |
} |
|
| 297 | ||
| 298 |
} // namespace fims_math |
|
| 299 | ||
| 300 |
#endif /* FIMS_MATH_HPP */ |
| 1 |
#include "benchmark/benchmark.h" |
|
| 2 |
#include "common/fims_math.hpp" |
|
| 3 | ||
| 4 | ! |
void BM_fims_math_double_logistic(benchmark::State &state) |
| 5 |
{
|
|
| 6 | ! |
for (auto _ : state) {
|
| 7 |
// inflection_point_asc, slope_asc, inflection_point_desc, slope_desc, x |
|
| 8 | ! |
fims_math::double_logistic(4.0, 2.5, 9.5, 0.5, 7.0); |
| 9 |
} |
|
| 10 |
|
|
| 11 |
} |
|
| 12 | ! |
BENCHMARK(BM_fims_math_double_logistic); |
| 1 |
#include "benchmark/benchmark.h" |
|
| 2 |
#include "common/fims_math.hpp" |
|
| 3 | ||
| 4 | ! |
void BM_fims_math_logistic(benchmark::State &state) |
| 5 |
{
|
|
| 6 | ! |
for (auto _ : state) {
|
| 7 |
// inflection_point, slope, x |
|
| 8 | ! |
fims_math::logistic(4.0, 2.5, 7.0); |
| 9 |
} |
|
| 10 |
|
|
| 11 |
} |
|
| 12 | ! |
BENCHMARK(BM_fims_math_logistic); |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "common/fims_math.hpp" |
|
| 3 | ||
| 4 |
namespace |
|
| 5 |
{
|
|
| 6 |
// Test double logistic using multiple input values |
|
| 7 | 22x |
TEST(DoubleLogistic, UseMultipleInputValues) |
| 8 |
{
|
|
| 9 | 3x |
std::vector<double> inflection_point_asc_value = {1.0, 10.0, 20.5};
|
| 10 | 3x |
std::vector<double> slope_asc_value = {0.0, 0.2, 0.05};
|
| 11 | 3x |
std::vector<double> inflection_point_desc_value = {6.0, 15.0, 23.5};
|
| 12 | 3x |
std::vector<double> slope_desc_value = {0.0, 0.2, 0.05};
|
| 13 | 3x |
std::vector<double> x_value = {2.0, 20.0, 40.5};
|
| 14 | ||
| 15 |
// R code that generates true values for the test |
|
| 16 |
// 1.0/(1.0+exp(-(2.0-1.0)*0.0)) * (1.0 - 1.0/(1.0+exp(-(2.0-6.0)*0.0))) = 0.25 |
|
| 17 |
// 1.0/(1.0+exp(-(20.0-10.0)*0.2)) * (1.0 - 1.0/(1.0+exp(-(20.0-15.0)*0.2))) = 0.2368828 |
|
| 18 |
// 1.0/(1.0+exp(-(40.5-20.5)*0.05)) * (1.0 - 1.0/(1.0+exp(-(40.5-23.5)*0.05))) = 0.218903 |
|
| 19 | ||
| 20 | 3x |
std::vector<double> expect_value = {0.25, 0.2368828, 0.218903};
|
| 21 | ||
| 22 | 12x |
for (int i = 0; i < expect_value.size(); ++i) |
| 23 |
{
|
|
| 24 | 9x |
EXPECT_NEAR(fims_math::double_logistic(inflection_point_asc_value[i], slope_asc_value[i], inflection_point_desc_value[i], slope_desc_value[i], x_value[i]), expect_value[i], 0.0001); |
| 25 |
} |
|
| 26 |
} |
|
| 27 | ||
| 28 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "common/fims_math.hpp" |
|
| 3 | ||
| 4 |
namespace |
|
| 5 |
{
|
|
| 6 | ||
| 7 |
// Test exp using multiple input values and types |
|
| 8 |
// Not worth to write many tests when testing thin database wrappers, |
|
| 9 |
// third-party libraries, or basic variable assignments. |
|
| 10 | ||
| 11 | 25x |
TEST(Exp, UseMultipleDoubleValues) |
| 12 |
{
|
|
| 13 |
// Test exp using large negative input value |
|
| 14 | 3x |
EXPECT_EQ(fims_math::exp(-1000000.0), std::exp(-1000000.0)); |
| 15 |
// Test exp using large positive input value |
|
| 16 | 3x |
EXPECT_EQ(fims_math::exp(1000000.0), std::exp(1000000.0)); |
| 17 |
// Test exp using double value 0.0 |
|
| 18 | 3x |
EXPECT_EQ(fims_math::exp(0.0), std::exp(0.0)); |
| 19 |
// Test exp using double value 1.0 |
|
| 20 | 3x |
EXPECT_EQ(fims_math::exp(1.0), std::exp(1.0)); |
| 21 |
// Test exp using double value 3.0 |
|
| 22 | 3x |
EXPECT_NEAR(fims_math::exp(3.0), 20.08554, 0.0001); |
| 23 |
// Test exp using double value -2.5 |
|
| 24 | 3x |
EXPECT_NEAR(fims_math::exp(-2.5), 0.082085, 0.0001); |
| 25 |
} |
|
| 26 | ||
| 27 | 25x |
TEST(Exp, UseIntegerValues) |
| 28 |
{
|
|
| 29 | ||
| 30 |
// Test exp using large positive integer value |
|
| 31 | 3x |
int input_value = 1000000; |
| 32 | 3x |
EXPECT_EQ(fims_math::exp<double>(input_value), std::exp(input_value)); |
| 33 | ||
| 34 |
// Test exp using integer value 3 |
|
| 35 |
// For fims_math::exp(3): the output value will be an integer if the input value is an integer |
|
| 36 |
// need to round the output value before using it as expected true value |
|
| 37 | 3x |
EXPECT_EQ(fims_math::exp(3), 20); |
| 38 |
} |
|
| 39 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "common/fims_math.hpp" |
|
| 3 | ||
| 4 |
namespace |
|
| 5 |
{
|
|
| 6 | ||
| 7 |
// Test ad_fabs |
|
| 8 | 56x |
TEST(AdFabs, UseDoubleValues) |
| 9 |
{
|
|
| 10 |
// Expected value from R: x=2; sqrt(x*x+1e-5) = 2.000002 |
|
| 11 | 6x |
EXPECT_NEAR(fims_math::ad_fabs(2.0), 2.000002, 0.000001); |
| 12 | 6x |
EXPECT_NE(fims_math::ad_fabs(2.0), 1.0); |
| 13 | ||
| 14 |
// Expected value from R: x=2; sqrt(x*x+1e-4) = 2.000025 |
|
| 15 | 6x |
EXPECT_NEAR(fims_math::ad_fabs(2.0, 1e-4), 2.000025, 0.000001); |
| 16 |
|
|
| 17 |
} |
|
| 18 | ||
| 19 |
// Test ad_min |
|
| 20 | 56x |
TEST(AdMin, UseDoubleValues) |
| 21 |
{
|
|
| 22 |
// Expected value from R: a=2.0; b=1.0; c=1e-5; |
|
| 23 |
// (a+b-sqrt((a-b)^2+c))*0.5 = 0.9999975 |
|
| 24 | 6x |
EXPECT_NEAR(fims_math::ad_min(2.0, 1.0), 0.9999975, 0.0000001); |
| 25 | 6x |
EXPECT_NE(fims_math::ad_min(2.0, 1.0), 2.0); |
| 26 | ||
| 27 |
// Expected value from R: a=2.0; b=1.0; c=1e-4; |
|
| 28 |
// (a+b-sqrt((a-b)^2+c))*0.5 = 0.999975 |
|
| 29 | 6x |
EXPECT_NEAR(fims_math::ad_min(2.0, 1.0, 1e-4), 0.999975, 0.000001); |
| 30 |
} |
|
| 31 | ||
| 32 |
// Test ad_max |
|
| 33 | 56x |
TEST(AdMax, UseDoubleValues) |
| 34 |
{
|
|
| 35 |
// Expected value from R: a=2.0; b=1.0; c=1e-5; |
|
| 36 |
// (a+b+sqrt((a-b)^2+c))*0.5 = 2.000002 |
|
| 37 | 6x |
EXPECT_NEAR(fims_math::ad_max(2.0, 1.0), 2.000002, 0.000001); |
| 38 | 6x |
EXPECT_NE(fims_math::ad_max(2.0, 1.0), 1.0); |
| 39 | ||
| 40 |
// Expected value from R: a=2.0; b=1.0; c=1e-4; |
|
| 41 |
// (a+b+sqrt((a-b)^2+c))*0.5 = 2.000025 |
|
| 42 | 6x |
EXPECT_NEAR(fims_math::ad_max(2.0, 1.0, 1e-4), 2.000025, 0.000001); |
| 43 | ||
| 44 |
} |
|
| 45 | ||
| 46 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "common/fims_math.hpp" |
|
| 3 | ||
| 4 |
namespace |
|
| 5 |
{
|
|
| 6 | ||
| 7 |
// Test log using multiple input values and types |
|
| 8 |
// Not worth to write many tests when testing thin database wrappers, |
|
| 9 |
// third-party libraries, or basic variable assignments. |
|
| 10 | ||
| 11 | 28x |
TEST(Log, UseMultipleDoubleValues) |
| 12 |
{
|
|
| 13 |
// Test log using large double value |
|
| 14 | 3x |
EXPECT_EQ(fims_math::log(1000000.0), std::log(1000000.0)); |
| 15 | ||
| 16 |
// Test log using double value 3.0 |
|
| 17 |
// R code that generates true values for the test |
|
| 18 |
// log(3.0): 1.098612 |
|
| 19 | 3x |
EXPECT_NEAR(fims_math::log(3.0), 1.098612, 0.0001); |
| 20 |
} |
|
| 21 | ||
| 22 | 28x |
TEST(Log, UseIntegerValues) |
| 23 |
{
|
|
| 24 |
// Test log using large positive integer value |
|
| 25 | 3x |
int large_int = 1000000; |
| 26 | 3x |
EXPECT_EQ(fims_math::log<double>(large_int), std::log(large_int)); |
| 27 | ||
| 28 |
// log(3.0): 1.098612 |
|
| 29 | 3x |
int small_int = 3; |
| 30 | 3x |
EXPECT_EQ(fims_math::log<double>(small_int), std::log(small_int)); |
| 31 |
} |
|
| 32 | ||
| 33 |
// log(-2.5): NaN |
|
| 34 | 28x |
TEST(Log, UseNegativeDoubleValues) |
| 35 |
{
|
|
| 36 |
// Test log using negative value -2.5 and expect return of NaN |
|
| 37 | 3x |
EXPECT_TRUE(std::isnan(fims_math::log(-2.5))); |
| 38 |
} |
|
| 39 | ||
| 40 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "common/fims_math.hpp" |
|
| 3 | ||
| 4 |
namespace |
|
| 5 |
{
|
|
| 6 | ||
| 7 |
// Test logistic using multiple input values |
|
| 8 | 22x |
TEST(Logistic, UseMultipleInputValues) |
| 9 |
{
|
|
| 10 | 3x |
std::vector<double> inflection_point_value = {1.0, 10.0, 20.5};
|
| 11 | 3x |
std::vector<double> slope_value = {0.0, 0.2, 0.05};
|
| 12 | 3x |
std::vector<double> x_value = {2.0, 20.0, 40.5};
|
| 13 | ||
| 14 |
// R code that generates true values for the test |
|
| 15 |
// 1.0/(1.0+exp(-(2.0-1.0)*0.0)) = 0.5 |
|
| 16 |
// 1.0/(1.0+exp(-(20.0-10.0)*0.2)) = 0.8807971 |
|
| 17 |
// 1.0/(1.0+exp(-(40.5-20.5)*0.05)) = 0.7310586 |
|
| 18 | 3x |
std::vector<double> expect_value = {0.5, 0.8807971, 0.7310586};
|
| 19 | ||
| 20 | 12x |
for (int i = 0; i < expect_value.size(); ++i) |
| 21 |
{
|
|
| 22 | 9x |
EXPECT_NEAR(fims_math::logistic(inflection_point_value[i], slope_value[i], x_value[i]), expect_value[i], 0.0001); |
| 23 |
} |
|
| 24 |
} |
|
| 25 | ||
| 26 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "common/fims_math.hpp" |
|
| 3 | ||
| 4 |
namespace |
|
| 5 |
{
|
|
| 6 | ||
| 7 |
// Test logit using multiple input values |
|
| 8 | 31x |
TEST(Logit, UseMultipleInputValues) |
| 9 |
{
|
|
| 10 | 3x |
std::vector<double> max_value = {1.0, 10.0, 20.5};
|
| 11 | 3x |
std::vector<double> min_value = {0.0, 0.2, 0.05};
|
| 12 | 3x |
std::vector<double> x_value = {0.5, 2.0, 4.5};
|
| 13 | ||
| 14 |
// R code that generates true values for the test |
|
| 15 |
// -log(max_value - x_value) + log(x_value - min_value) |
|
| 16 |
// = 0.000000 -1.491655 -1.279685 |
|
| 17 | 3x |
std::vector<double> expect_value = {0.0, -1.491655, -1.279685};
|
| 18 | ||
| 19 |
} |
|
| 20 | ||
| 21 | 31x |
TEST(InvLogit, UseMultipleInputValues) |
| 22 |
{
|
|
| 23 | 3x |
std::vector<double> max_value = {1.0, 10.0, 20.5};
|
| 24 | 3x |
std::vector<double> min_value = {0.0, 0.2, 0.05};
|
| 25 | 3x |
std::vector<double> logit_x_value = {0, -1.491655, -1.279685};
|
| 26 | ||
| 27 |
// R code that generates true values for the test |
|
| 28 |
// max_value - (max_value - min_value)/(1+exp(-logit_x_value)) |
|
| 29 |
// |
|
| 30 | 3x |
std::vector<double> expect_value = {0.5, 2.0, 4.5};
|
| 31 | ||
| 32 | 12x |
for (int i = 0; i < expect_value.size(); ++i) |
| 33 |
{
|
|
| 34 | 9x |
EXPECT_NEAR(fims_math::inv_logit(min_value[i], max_value[i], logit_x_value[i]), |
| 35 |
expect_value[i], 0.0001); |
|
| 36 |
} |
|
| 37 |
} |
|
| 38 | ||
| 39 | 31x |
TEST(InvLogitLogit, UseMultipleInputValues) |
| 40 |
{
|
|
| 41 |
|
|
| 42 | 3x |
std::vector<double> max_value = {1.0, 1.0};
|
| 43 | 3x |
std::vector<double> min_value = {0.0, 0.0};
|
| 44 | 3x |
std::vector<double> x_value = {0.0, 1.0};
|
| 45 | ||
| 46 | 9x |
for (int i = 0; i < x_value.size(); ++i) |
| 47 |
{
|
|
| 48 | 6x |
EXPECT_EQ(fims_math::inv_logit(min_value[i], max_value[i], |
| 49 |
fims_math::logit(min_value[i], max_value[i], x_value[i])), |
|
| 50 |
x_value[i]); |
|
| 51 |
} |
|
| 52 |
} |
|
| 53 | ||
| 54 | 31x |
TEST(LogitInvLogit, UseMultipleInputValues) |
| 55 |
{
|
|
| 56 |
|
|
| 57 | 3x |
std::vector<double> max_value = {1.0, 1.0};
|
| 58 | 3x |
std::vector<double> min_value = {0.0, 0.0};
|
| 59 | 3x |
std::vector<double> x_value = {-INFINITY, INFINITY};
|
| 60 | ||
| 61 | 9x |
for (int i = 0; i < x_value.size(); ++i) |
| 62 |
{
|
|
| 63 | 6x |
EXPECT_EQ(fims_math::logit(min_value[i], max_value[i], |
| 64 |
fims_math::inv_logit(min_value[i], max_value[i], x_value[i])), |
|
| 65 |
x_value[i]); |
|
| 66 |
} |
|
| 67 | ||
| 68 | ||
| 69 |
} |
|
| 70 | ||
| 71 |
} |
| 1 |
/** |
|
| 2 |
* @file def.hpp |
|
| 3 |
* @brief TODO: provide a brief description. |
|
| 4 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 5 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 6 |
* folder for reuse information. |
|
| 7 |
*/ |
|
| 8 |
#ifndef DEF_HPP |
|
| 9 |
#define DEF_HPP |
|
| 10 |
#include <fstream> |
|
| 11 |
#include <map> |
|
| 12 |
#include <memory> |
|
| 13 |
#include <vector> |
|
| 14 |
#include <string> |
|
| 15 |
#include <unordered_map> |
|
| 16 | ||
| 17 | ||
| 18 |
#include <cstdlib> |
|
| 19 |
#include <chrono> |
|
| 20 |
#include <sstream> |
|
| 21 |
#include <iostream> |
|
| 22 |
#include <filesystem> |
|
| 23 |
#include <stdlib.h> |
|
| 24 |
#include <fstream> |
|
| 25 |
#include <signal.h> |
|
| 26 |
#include <csignal> |
|
| 27 |
#include <cstring> |
|
| 28 | ||
| 29 |
#include <stdexcept> |
|
| 30 | ||
| 31 | ||
| 32 |
#if defined(linux) || defined(__linux) || defined(__linux__) |
|
| 33 |
#define FIMS_LINUX |
|
| 34 |
#elif defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__) || defined(__DragonFly__) |
|
| 35 |
#define FIMS_BSD |
|
| 36 |
#elif defined(sun) || defined(__sun) |
|
| 37 |
#define FIMS_SOLARIS |
|
| 38 |
#elif defined(__sgi) |
|
| 39 |
#define FIMS_IRIX |
|
| 40 |
#elif defined(__hpux) |
|
| 41 |
#define FIMS_HPUX |
|
| 42 |
#elif defined(__CYGWIN__) |
|
| 43 |
#define FIMS_CYGWIN |
|
| 44 |
#elif defined(_WIN32) || defined(__WIN32__) || defined(WIN32) |
|
| 45 |
#define FIMS_WIN32 |
|
| 46 |
#elif defined(_WIN64) || defined(__WIN64__) || defined(WIN64) |
|
| 47 |
#define FIMS_WIN64 |
|
| 48 |
#elif defined(__BEOS__) |
|
| 49 |
#define FIMS_BEOS |
|
| 50 |
#elif defined(macintosh) || defined(__APPLE__) || defined(__APPLE_CC__) |
|
| 51 |
#define FIMS_MACOS |
|
| 52 |
#elif defined(__IBMCPP__) || defined(_AIX) |
|
| 53 |
#define FIMS_AIX |
|
| 54 |
#elif defined(__amigaos__) |
|
| 55 |
#define FIMS_AMIGAOS |
|
| 56 |
#elif defined(__QNXNTO__) |
|
| 57 |
#define FIMS_QNXNTO |
|
| 58 |
#endif |
|
| 59 | ||
| 60 |
#if defined(FIMS_WIN32) || defined(FIMS_WIN64) |
|
| 61 |
#define FIMS_WINDOWS |
|
| 62 |
#endif |
|
| 63 | ||
| 64 |
#ifdef FIMS_WINDOWS |
|
| 65 |
#include <Windows.h> |
|
| 66 |
#endif |
|
| 67 | ||
| 68 |
#if !defined(__PRETTY_FUNCTION__) && !defined(__GNUC__) |
|
| 69 |
#ifdef FIMS_WINDOWS |
|
| 70 |
#define __PRETTY_FUNCTION__ __FUNCTION__ |
|
| 71 |
#endif |
|
| 72 |
#endif |
|
| 73 | ||
| 74 |
// The following rows initialize default log files for outputing model progress |
|
| 75 |
// comments used to assist in diagnosing model issues and tracking progress. |
|
| 76 |
// These files will only be created if a logs folder is added to the root model |
|
| 77 |
// directory. |
|
| 78 | ||
| 79 |
#ifdef TMB_MODEL |
|
| 80 |
// simplify access to singletons |
|
| 81 |
#define TMB_FIMS_REAL_TYPE double |
|
| 82 |
#define TMB_FIMS_FIRST_ORDER AD<TMB_FIMS_REAL_TYPE> |
|
| 83 |
#define TMB_FIMS_SECOND_ORDER AD<TMB_FIMS_FIRST_ORDER> |
|
| 84 |
#define TMB_FIMS_THIRD_ORDER AD<TMB_FIMS_SECOND_ORDER> |
|
| 85 |
#endif |
|
| 86 | ||
| 87 |
namespace fims {
|
|
| 88 | ||
| 89 |
/** |
|
| 90 |
* Log entry. |
|
| 91 |
*/ |
|
| 92 | ! |
struct LogEntry {
|
| 93 |
/** The date/time that the log entry was created, e.g., "Oct 28 09:18:51 2024". You can track how long it took to work through each portion of the model by analyzing the progression of the timestamp through the log file.*/ |
|
| 94 |
std::string timestamp; |
|
| 95 |
/** The description of the log entry, e.g., "Adding Selectivity object to TMB" or "Mismatch dimension error", where the descriptions are predefined in the C++ code. Please make a GitHub issue or contact a developer if you have ideas for a more informative description.*/ |
|
| 96 |
std::string message; |
|
| 97 |
/** The logging level, which is a result of which macro was used to generate the message, e.g., FIMS_INFO_LOG(), FIMS_WARNING_LOG(), or FIMS_ERROR_LOG() results in "info", "warning", or "error", respectively, in the log file. An additional level is available to developers from FIMS_DEBUG_LOG(), resulting in a level of "debug", but this macro is only available in branches other than main.*/ |
|
| 98 |
std::string level; |
|
| 99 |
/** The message id, directly corresponds to the order in which the entries were created, e.g., "1", which is helpful for knowing the order of operations within the code base and comparing log files across model runs.*/ |
|
| 100 |
size_t rank; |
|
| 101 |
/** The user name registered to the computer where the log file was created, e.g., "John.Doe".*/ |
|
| 102 |
std::string user; |
|
| 103 |
/** The working directory for the R environment that created the log file, e.g., "C:/github/NOAA-FIMS/FIMS/vignettes" if you are on a Windows machine or "/home/oppy/FIMS-Testing/dev/dev_logging/FIMS/vignettes" if you are on a linux machine.*/ |
|
| 104 |
std::string wd; |
|
| 105 |
/** The full file path of the file that triggered the log entry, e.g., "C:/github/NOAA-FIMS/FIMS/inst/include/interface/rcpp/rcpp_objects/rcpp_selectivity.hpp".*/ |
|
| 106 |
std::string file; |
|
| 107 |
/** The function or method that led to the initialization the log entry, e.g., "virtual bool LogisticSelectivityInterface::add_to_fims_tmb()". If the function is templated, then the function type will be reported here in square brackets after the function name, e.g., "bool fims_info::Information<Type>::CreateModel() [with Type = double]".*/ |
|
| 108 |
std::string routine; |
|
| 109 |
/** The line in `file` where the log entry was initiated, e.g., "219", which will be a line inside of the `routine` listed above.*/ |
|
| 110 |
int line; |
|
| 111 | ||
| 112 |
/** |
|
| 113 |
* Convert this object to a string. |
|
| 114 |
*/ |
|
| 115 | ! |
std::string to_string() {
|
| 116 | ! |
std::stringstream ss; |
| 117 | ! |
ss << "\"timestamp\" : " << "\"" << this->timestamp << "\"" << ",\n"; |
| 118 | ! |
ss << "\"level\" : " << "\"" << this->level << "\",\n"; |
| 119 | ! |
ss << "\"message\" : " << "\"" << this->message << "\",\n"; |
| 120 | ! |
ss << "\"id\" : " << "\"" << this->rank << "\",\n"; |
| 121 | ! |
ss << "\"user\" : " << "\"" << this->user << "\",\n"; |
| 122 | ! |
ss << "\"wd\" : " << "\"" << this->wd << "\",\n"; |
| 123 | ! |
ss << "\"file\" : " << "\"" << this->file << "\",\n"; |
| 124 | ! |
ss << "\"routine\" : " << "\"" << this->routine << "\",\n"; |
| 125 | ! |
ss << "\"line\" : " << "\"" << this->line << "\"\n"; |
| 126 | ! |
return ss.str(); |
| 127 |
} |
|
| 128 | ||
| 129 |
}; |
|
| 130 | ||
| 131 |
/** |
|
| 132 |
* FIMS logging class. |
|
| 133 |
*/ |
|
| 134 |
class FIMSLog {
|
|
| 135 |
std::vector<std::string> entries; |
|
| 136 |
std::vector<LogEntry> log_entries; |
|
| 137 | 93x |
size_t entry_number = 0; |
| 138 | 93x |
std::string path = "fims.log"; |
| 139 | 93x |
size_t warning_count = 0; |
| 140 | 93x |
size_t error_count = 0; |
| 141 | ||
| 142 |
/** |
|
| 143 |
* Get username. |
|
| 144 |
* |
|
| 145 |
* @return username. |
|
| 146 |
*/ |
|
| 147 | ! |
std::string get_user() {
|
| 148 |
char * user; |
|
| 149 | ! |
std::string user_ret = "UNKOWN_USER"; |
| 150 | ||
| 151 |
#ifdef FIMS_WINDOWS |
|
| 152 |
user = getenv("username");
|
|
| 153 |
user_ret = std::string(user); |
|
| 154 |
#endif |
|
| 155 |
#ifdef FIMS_LINUX |
|
| 156 |
user = getenv("USER");
|
|
| 157 |
user_ret = std::string(user); |
|
| 158 |
#endif |
|
| 159 | ||
| 160 |
#ifdef FIMS_MACOS |
|
| 161 | ! |
user = getenv("USER");
|
| 162 | ! |
user_ret = std::string(user); |
| 163 |
#endif |
|
| 164 | ||
| 165 | ! |
return user_ret; |
| 166 |
} |
|
| 167 |
public: |
|
| 168 | 93x |
bool write_on_exit = true; /*!<TODO: Document>*/ |
| 169 | 93x |
bool throw_on_error = false; /*!<TODO: Document>*/ |
| 170 |
static std::shared_ptr<FIMSLog> fims_log; /*!<TODO: Document>*/ |
|
| 171 | ||
| 172 |
/** |
|
| 173 |
* Default constructor. |
|
| 174 |
*/ |
|
| 175 | 186x |
FIMSLog() {
|
| 176 | ||
| 177 |
} |
|
| 178 | ||
| 179 |
/** |
|
| 180 |
* Destructor. If write_on_exit is set to true, |
|
| 181 |
* the log will be written to the disk in JSON format. |
|
| 182 |
*/ |
|
| 183 | ! |
~FIMSLog() {
|
| 184 | ! |
if (this->write_on_exit) {
|
| 185 | ! |
std::ofstream log(this->path); |
| 186 | ! |
log << this->get_log(); |
| 187 | ! |
log.close(); |
| 188 |
} |
|
| 189 |
} |
|
| 190 | ||
| 191 |
/** |
|
| 192 |
* @brief Get the Absolute Path Without Dot Dot object |
|
| 193 |
* |
|
| 194 |
* Dot dot notation is for relative paths, where this function replaces |
|
| 195 |
* all dot dots with the actual full path. |
|
| 196 |
* |
|
| 197 |
* @param relativePath A path in your file system. |
|
| 198 |
* @return std::filesystem::path |
|
| 199 |
*/ |
|
| 200 | ! |
std::filesystem::path getAbsolutePathWithoutDotDot(const std::filesystem::path& relativePath) {
|
| 201 | ! |
std::filesystem::path absolutePath = std::filesystem::absolute(relativePath); |
| 202 | ||
| 203 | ! |
std::filesystem::path result; |
| 204 | ! |
for (const auto& part : absolutePath) {
|
| 205 | ! |
if (part == "..") {
|
| 206 | ! |
if (!result.empty()) {
|
| 207 | ! |
result = result.parent_path(); |
| 208 |
} |
|
| 209 |
} else {
|
|
| 210 | ! |
result /= part; |
| 211 |
} |
|
| 212 |
} |
|
| 213 | ||
| 214 | ! |
return result.generic_string(); |
| 215 |
} |
|
| 216 | ||
| 217 |
/** |
|
| 218 |
* Set a path for the log file. |
|
| 219 |
* |
|
| 220 |
* @param path |
|
| 221 |
*/ |
|
| 222 | ! |
void set_path(std::string path) {
|
| 223 | ! |
this->path = path; |
| 224 |
} |
|
| 225 | ||
| 226 |
/** |
|
| 227 |
* Get the path for the log file. |
|
| 228 |
* |
|
| 229 |
* @return |
|
| 230 |
*/ |
|
| 231 | ! |
std::string get_path() {
|
| 232 | ! |
return this->path; |
| 233 |
} |
|
| 234 | ||
| 235 |
/** |
|
| 236 |
* Add a "info" level message to the log. |
|
| 237 |
* |
|
| 238 |
* @param str |
|
| 239 |
* @param line |
|
| 240 |
* @param file |
|
| 241 |
* @param func |
|
| 242 |
*/ |
|
| 243 | ! |
void info_message(std::string str, int line, const char* file, const char* func) {
|
| 244 | ! |
std::filesystem::path relativePath = file; |
| 245 | ! |
std::filesystem::path absolutePath = getAbsolutePathWithoutDotDot(relativePath); |
| 246 | ! |
std::filesystem::path cwd = std::filesystem::current_path(); |
| 247 | ! |
std::stringstream ss; |
| 248 | ! |
auto now = std::chrono::system_clock::now(); |
| 249 | ! |
std::time_t now_time = std::chrono::system_clock::to_time_t(now); |
| 250 | ! |
std::string ctime_no_newline = strtok(ctime(&now_time), "\n"); |
| 251 | ||
| 252 | ! |
LogEntry l; |
| 253 | ! |
l.timestamp = ctime_no_newline; |
| 254 | ! |
l.message = str; |
| 255 | ! |
l.level = "info"; |
| 256 | ! |
l.rank = this->log_entries.size(); |
| 257 | ! |
l.user = this->get_user(); |
| 258 | ! |
l.wd = cwd.generic_string(); |
| 259 | ! |
l.file = absolutePath.string(); |
| 260 | ! |
l.line = line; |
| 261 | ! |
l.routine = func; |
| 262 | ! |
this->log_entries.push_back(l); |
| 263 | ||
| 264 |
} |
|
| 265 | ||
| 266 |
/** |
|
| 267 |
* Add a "debug" level message to the log. |
|
| 268 |
* |
|
| 269 |
* @param str |
|
| 270 |
* @param line |
|
| 271 |
* @param file |
|
| 272 |
* @param func |
|
| 273 |
*/ |
|
| 274 |
void debug_message(std::string str, int line, const char* file, const char* func) {
|
|
| 275 |
std::filesystem::path relativePath = file; |
|
| 276 |
std::filesystem::path absolutePath = getAbsolutePathWithoutDotDot(relativePath); |
|
| 277 |
std::filesystem::path cwd = std::filesystem::current_path(); |
|
| 278 |
std::stringstream ss; |
|
| 279 |
auto now = std::chrono::system_clock::now(); |
|
| 280 |
std::time_t now_time = std::chrono::system_clock::to_time_t(now); |
|
| 281 |
std::string ctime_no_newline = strtok(ctime(&now_time), "\n"); |
|
| 282 | ||
| 283 |
LogEntry l; |
|
| 284 |
l.timestamp = ctime_no_newline; |
|
| 285 |
l.message = str; |
|
| 286 |
l.level = "debug"; |
|
| 287 |
l.rank = this->log_entries.size(); |
|
| 288 |
l.user = this->get_user(); |
|
| 289 |
l.wd = cwd.generic_string(); |
|
| 290 |
l.file = absolutePath.string(); |
|
| 291 |
l.line = line; |
|
| 292 |
l.routine = func; |
|
| 293 |
this->log_entries.push_back(l); |
|
| 294 | ||
| 295 |
} |
|
| 296 | ||
| 297 |
/** |
|
| 298 |
* Add a "error" level message to the log. |
|
| 299 |
* |
|
| 300 |
* @param str |
|
| 301 |
* @param line |
|
| 302 |
* @param file |
|
| 303 |
* @param func |
|
| 304 |
*/ |
|
| 305 | ! |
void error_message(std::string str, int line, const char* file, const char* func) {
|
| 306 | ! |
this->error_count++; |
| 307 | ! |
std::filesystem::path relativePath = file; |
| 308 | ! |
std::filesystem::path absolutePath = getAbsolutePathWithoutDotDot(relativePath); |
| 309 | ! |
std::filesystem::path cwd = std::filesystem::current_path(); |
| 310 | ||
| 311 | ! |
std::stringstream ss; |
| 312 | ! |
auto now = std::chrono::system_clock::now(); |
| 313 | ! |
std::time_t now_time = std::chrono::system_clock::to_time_t(now); |
| 314 | ! |
std::string ctime_no_newline = strtok(ctime(&now_time), "\n"); |
| 315 | ||
| 316 | ! |
LogEntry l; |
| 317 | ! |
l.timestamp = ctime_no_newline; |
| 318 | ! |
l.message = str; |
| 319 | ! |
l.level = "error"; |
| 320 | ! |
l.rank = this->log_entries.size(); |
| 321 | ! |
l.user = this->get_user(); |
| 322 | ! |
l.wd = cwd.generic_string(); |
| 323 | ! |
l.file = absolutePath.string(); |
| 324 | ! |
l.line = line; |
| 325 | ! |
l.routine = func; |
| 326 | ! |
this->log_entries.push_back(l); |
| 327 | ||
| 328 | ! |
if (this->throw_on_error) {
|
| 329 | ! |
std::stringstream ss; |
| 330 | ! |
ss << "\n\n" << l.to_string() << "\n\n"; |
| 331 | ! |
throw std::runtime_error(ss.str().c_str()); |
| 332 |
} |
|
| 333 | ||
| 334 |
} |
|
| 335 | ||
| 336 |
/** |
|
| 337 |
* Add a "warning" level message to the log. |
|
| 338 |
* |
|
| 339 |
* @param str |
|
| 340 |
* @param line |
|
| 341 |
* @param file |
|
| 342 |
* @param func |
|
| 343 |
*/ |
|
| 344 | ! |
void warning_message(std::string str, int line, const char* file, const char* func) {
|
| 345 | ! |
this->warning_count++; |
| 346 | ! |
std::filesystem::path relativePath = file; |
| 347 | ! |
std::filesystem::path absolutePath = getAbsolutePathWithoutDotDot(relativePath); |
| 348 | ! |
std::filesystem::path cwd = std::filesystem::current_path(); |
| 349 | ||
| 350 | ! |
std::stringstream ss; |
| 351 | ! |
auto now = std::chrono::system_clock::now(); |
| 352 | ! |
std::time_t now_time = std::chrono::system_clock::to_time_t(now); |
| 353 | ! |
std::string ctime_no_newline = strtok(ctime(&now_time), "\n"); |
| 354 | ||
| 355 | ! |
LogEntry l; |
| 356 | ! |
l.timestamp = ctime_no_newline; |
| 357 | ! |
l.message = str; |
| 358 | ! |
l.level = "warning"; |
| 359 | ! |
l.rank = this->log_entries.size(); |
| 360 | ! |
l.user = this->get_user(); |
| 361 | ! |
l.wd = cwd.generic_string(); |
| 362 | ! |
l.file = absolutePath.string(); |
| 363 | ! |
l.line = line; |
| 364 | ! |
l.routine = func; |
| 365 | ! |
this->log_entries.push_back(l); |
| 366 | ||
| 367 |
} |
|
| 368 | ||
| 369 |
/** |
|
| 370 |
* Get the log as a string object. |
|
| 371 |
* |
|
| 372 |
* @return |
|
| 373 |
*/ |
|
| 374 | ! |
std::string get_log() {
|
| 375 | ! |
std::stringstream ss; |
| 376 | ! |
if (log_entries.size() == 0) {
|
| 377 | ! |
ss << "[\n]"; |
| 378 |
} else {
|
|
| 379 | ! |
ss << "[\n"; |
| 380 | ! |
for (size_t i = 0; i < log_entries.size() - 1; i++) {
|
| 381 | ! |
ss << "{\n" << this->log_entries[i].to_string() << "},\n";
|
| 382 | ||
| 383 |
} |
|
| 384 | ! |
ss << "{\n" << this->log_entries[log_entries.size() - 1].to_string() << "}\n]";
|
| 385 |
} |
|
| 386 | ! |
return ss.str(); |
| 387 |
} |
|
| 388 | ||
| 389 |
/** |
|
| 390 |
* Return only error entries from the log. |
|
| 391 |
* |
|
| 392 |
* @return |
|
| 393 |
*/ |
|
| 394 | ! |
std::string get_errors() {
|
| 395 | ! |
std::stringstream ss; |
| 396 | ! |
std::vector<LogEntry> errors; |
| 397 | ! |
for (size_t i = 0; i < log_entries.size(); i++) {
|
| 398 | ! |
if (log_entries[i].level == "error") {
|
| 399 | ! |
errors.push_back(this->log_entries[i]); |
| 400 |
} |
|
| 401 |
} |
|
| 402 | ||
| 403 | ! |
if (errors.size() == 0) {
|
| 404 | ! |
ss << "[\n]"; |
| 405 |
} else {
|
|
| 406 | ! |
ss << "[\n"; |
| 407 | ! |
for (size_t i = 0; i < errors.size() - 1; i++) {
|
| 408 | ||
| 409 | ! |
ss << "{\n" << errors[i].to_string() << "},\n";
|
| 410 | ||
| 411 |
} |
|
| 412 | ||
| 413 | ! |
ss << "{\n" << errors[errors.size() - 1].to_string() << "}\n]";
|
| 414 | ||
| 415 |
} |
|
| 416 | ! |
return ss.str(); |
| 417 |
} |
|
| 418 | ||
| 419 |
/** |
|
| 420 |
* Return only warning entries from the log. |
|
| 421 |
* |
|
| 422 |
* @return |
|
| 423 |
*/ |
|
| 424 | ! |
std::string get_warnings() {
|
| 425 | ! |
std::stringstream ss; |
| 426 | ! |
std::vector<LogEntry> warnings; |
| 427 | ! |
for (size_t i = 0; i < log_entries.size(); i++) {
|
| 428 | ! |
if (log_entries[i].level == "warning") {
|
| 429 | ! |
warnings.push_back(this->log_entries[i]); |
| 430 |
} |
|
| 431 |
} |
|
| 432 | ||
| 433 | ! |
if (warnings.size() == 0) {
|
| 434 | ! |
ss << "[\n]"; |
| 435 |
} else {
|
|
| 436 | ! |
ss << "[\n"; |
| 437 | ! |
for (size_t i = 0; i < warnings.size() - 1; i++) {
|
| 438 | ||
| 439 | ! |
ss << "{\n" << warnings[i].to_string() << "},\n";
|
| 440 | ||
| 441 |
} |
|
| 442 | ||
| 443 | ! |
ss << "{\n" << warnings[warnings.size() - 1].to_string() << "}\n]";
|
| 444 | ||
| 445 |
} |
|
| 446 | ! |
return ss.str(); |
| 447 |
} |
|
| 448 | ||
| 449 |
/** |
|
| 450 |
* Return only info entries from the log. |
|
| 451 |
* |
|
| 452 |
* @return |
|
| 453 |
*/ |
|
| 454 | ! |
std::string get_info() {
|
| 455 | ! |
std::stringstream ss; |
| 456 | ! |
std::vector<LogEntry> info; |
| 457 | ! |
for (size_t i = 0; i < log_entries.size(); i++) {
|
| 458 | ! |
if (log_entries[i].level == "info") {
|
| 459 | ! |
info.push_back(this->log_entries[i]); |
| 460 |
} |
|
| 461 |
} |
|
| 462 | ||
| 463 | ! |
if (info.size() == 0) {
|
| 464 | ! |
ss << "[\n]"; |
| 465 |
} else {
|
|
| 466 | ! |
ss << "[\n"; |
| 467 | ! |
for (size_t i = 0; i < info.size() - 1; i++) {
|
| 468 | ||
| 469 | ! |
ss << "{\n" << info[i].to_string() << "},\n";
|
| 470 | ||
| 471 |
} |
|
| 472 | ||
| 473 | ! |
ss << "{\n" << info[info.size() - 1].to_string() << "}\n]";
|
| 474 | ||
| 475 |
} |
|
| 476 | ! |
return ss.str(); |
| 477 |
} |
|
| 478 | ||
| 479 |
/** |
|
| 480 |
* Query the log by module. |
|
| 481 |
* |
|
| 482 |
* @param module |
|
| 483 |
* @return |
|
| 484 |
*/ |
|
| 485 | ! |
std::string get_module(const std::string& module) {
|
| 486 | ! |
std::stringstream ss; |
| 487 | ! |
std::vector<LogEntry> info; |
| 488 | ! |
for (size_t i = 0; i < log_entries.size(); i++) {
|
| 489 | ! |
if (log_entries[i].file.find(module) != std::string::npos) {
|
| 490 | ! |
info.push_back(this->log_entries[i]); |
| 491 |
} |
|
| 492 |
} |
|
| 493 | ||
| 494 | ! |
if (info.size() == 0) {
|
| 495 | ! |
ss << "[\n]"; |
| 496 |
} else {
|
|
| 497 | ! |
ss << "[\n"; |
| 498 | ! |
for (size_t i = 0; i < info.size() - 1; i++) {
|
| 499 | ||
| 500 | ! |
ss << "{\n" << info[i].to_string() << "},\n";
|
| 501 | ||
| 502 |
} |
|
| 503 | ||
| 504 | ! |
ss << "{\n" << info[info.size() - 1].to_string() << "}\n]";
|
| 505 | ||
| 506 |
} |
|
| 507 | ! |
return ss.str(); |
| 508 |
} |
|
| 509 | ||
| 510 |
/** |
|
| 511 |
* @brief Get the counts of the number of errors |
|
| 512 |
*/ |
|
| 513 |
size_t get_error_count() const {
|
|
| 514 |
return error_count; |
|
| 515 |
} |
|
| 516 | ||
| 517 |
/** |
|
| 518 |
* @brief Get the counts of the number of warnings |
|
| 519 |
*/ |
|
| 520 |
size_t get_warning_count() const {
|
|
| 521 |
return warning_count; |
|
| 522 |
} |
|
| 523 | ||
| 524 |
/** |
|
| 525 |
* @brief Clears all pointers/references of a FIMS model. |
|
| 526 |
* |
|
| 527 |
*/ |
|
| 528 | ! |
void clear() {
|
| 529 | ! |
this->entries.clear(); |
| 530 | ! |
this->log_entries.clear(); |
| 531 | ! |
this->warning_count = 0; |
| 532 | ! |
this->entry_number = 0; |
| 533 |
} |
|
| 534 | ||
| 535 |
}; |
|
| 536 | ||
| 537 | ||
| 538 |
std::shared_ptr<FIMSLog> FIMSLog::fims_log = std::make_shared<FIMSLog>(); |
|
| 539 | ||
| 540 |
} // namespace fims |
|
| 541 | ||
| 542 | ||
| 543 | ||
| 544 | ||
| 545 | ||
| 546 |
#ifdef FIMS_DEBUG |
|
| 547 | ||
| 548 |
#define FIMS_DEBUG_LOG(MESSAGE) FIMSLog::fims_log->debug_message(MESSAGE, __LINE__, __FILE__, __PRETTY_FUNCTION__); |
|
| 549 | ||
| 550 |
#else |
|
| 551 | ||
| 552 |
#define FIMS_DEBUG_LOG(MESSAGE) /**< Print MESSAGE to debug log */ |
|
| 553 | ||
| 554 |
#endif |
|
| 555 | ||
| 556 |
#define FIMS_INFO_LOG(MESSAGE) fims::FIMSLog::fims_log->info_message(MESSAGE, __LINE__, __FILE__, __PRETTY_FUNCTION__); /**< Print MESSAGE to info log */ |
|
| 557 | ||
| 558 |
#define FIMS_WARNING_LOG(MESSAGE) fims::FIMSLog::fims_log->warning_message(MESSAGE, __LINE__, __FILE__, __PRETTY_FUNCTION__); /**< Print MESSAGE to warning log */ |
|
| 559 | ||
| 560 |
#define FIMS_ERROR_LOG(MESSAGE) fims::FIMSLog::fims_log->error_message(MESSAGE, __LINE__, __FILE__, __PRETTY_FUNCTION__); /**< Print MESSAGE to error log */ |
|
| 561 | ||
| 562 |
#define FIMS_STR(s) #s /**< String of s */ |
|
| 563 | ||
| 564 | ||
| 565 |
namespace fims {
|
|
| 566 | ||
| 567 |
/** |
|
| 568 |
* Signal intercept function. Writes the log to the disk before |
|
| 569 |
* a crash occurs. |
|
| 570 |
* |
|
| 571 |
* @param sig |
|
| 572 |
*/ |
|
| 573 | ! |
void WriteAtExit(int sig) {
|
| 574 | ||
| 575 | ! |
std::string signal_error = "NA"; |
| 576 | ! |
switch (sig) {
|
| 577 |
case SIGSEGV: |
|
| 578 | ! |
signal_error = "Invalid memory access (segmentation fault)"; |
| 579 | ! |
break; |
| 580 |
case SIGINT: |
|
| 581 | ! |
signal_error = "External interrupt, possibly initiated by the user."; |
| 582 | ! |
break; |
| 583 |
case SIGABRT: |
|
| 584 | ! |
signal_error = "Abnormal termination condition, possible call to std::abort."; |
| 585 | ! |
break; |
| 586 |
case SIGFPE: |
|
| 587 | ! |
signal_error = "Erroneous arithmetic operation."; |
| 588 | ! |
break; |
| 589 |
case SIGILL: |
|
| 590 | ! |
signal_error = "Invalid program image or invalid instruction"; |
| 591 | ! |
break; |
| 592 |
case SIGTERM: |
|
| 593 | ! |
signal_error = "Termination request, sent to the program."; |
| 594 | ! |
break; |
| 595 |
default: |
|
| 596 | ! |
signal_error = "Unknown signal thrown"; |
| 597 | ||
| 598 |
} |
|
| 599 | ||
| 600 | ! |
FIMSLog::fims_log->error_message(signal_error, -999, "?", "?"); |
| 601 | ||
| 602 | ||
| 603 | ! |
if (FIMSLog::fims_log->write_on_exit) {
|
| 604 | ||
| 605 | ! |
std::ofstream log(FIMSLog::fims_log->get_path()); |
| 606 | ! |
log << FIMSLog::fims_log->get_log(); |
| 607 | ! |
log.close(); |
| 608 |
} |
|
| 609 | ! |
std::signal(sig, SIG_DFL); |
| 610 | ! |
raise(sig); |
| 611 |
} |
|
| 612 | ||
| 613 |
/** |
|
| 614 |
* Converts an object T to a string. |
|
| 615 |
* |
|
| 616 |
* @param v |
|
| 617 |
* @return |
|
| 618 |
*/ |
|
| 619 |
template<typename T> |
|
| 620 | ! |
std::string to_string(T v) {
|
| 621 | ! |
std::stringstream ss; |
| 622 | ! |
ss << v; |
| 623 | ! |
return ss.str(); |
| 624 |
} |
|
| 625 | ||
| 626 |
} |
|
| 627 | ||
| 628 |
#endif /* TRAITS_HPP */ |
| 1 |
/** |
|
| 2 |
* @file model_object.hpp |
|
| 3 |
* @brief TODO: provide a brief description. |
|
| 4 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 5 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 6 |
* folder for reuse information. |
|
| 7 |
*/ |
|
| 8 | ||
| 9 |
#ifndef FIMS_COMMON_MODEL_OBJECT_HPP |
|
| 10 |
#define FIMS_COMMON_MODEL_OBJECT_HPP |
|
| 11 | ||
| 12 |
#include <stdint.h> |
|
| 13 | ||
| 14 |
#include <vector> |
|
| 15 | ||
| 16 |
#include "def.hpp" |
|
| 17 | ||
| 18 |
namespace fims_model_object {
|
|
| 19 | ||
| 20 |
/** |
|
| 21 |
* @brief FIMSObject struct that defines member types and returns the unique id |
|
| 22 |
*/ |
|
| 23 |
template <typename Type> |
|
| 24 |
struct FIMSObject {
|
|
| 25 |
uint32_t id; /**< unique identifier assigned for all fims objects */ |
|
| 26 |
std::vector<Type*> parameters; /**< list of estimable parameters */ |
|
| 27 |
std::vector<Type*> |
|
| 28 |
random_effects_parameters; /**< list of all random effects parameters */ |
|
| 29 |
std::vector<Type*> |
|
| 30 |
fixed_effects_parameters; /**< list of fixed effects parameters */ |
|
| 31 | ||
| 32 | 380x |
virtual ~FIMSObject() {
|
| 33 |
} |
|
| 34 | ||
| 35 |
/** |
|
| 36 |
* @brief Getter that returns the unique id for parameters in the model |
|
| 37 |
*/ |
|
| 38 | 12x |
uint32_t GetId() const {
|
| 39 | 12x |
return id; |
| 40 |
} |
|
| 41 | ||
| 42 |
/** |
|
| 43 |
* @brief Check the dimensions of an object |
|
| 44 |
* |
|
| 45 |
* @param actual The actual dimensions. |
|
| 46 |
* @param expected The expected dimensions. |
|
| 47 |
* @return true |
|
| 48 |
* @return false |
|
| 49 |
*/ |
|
| 50 |
inline bool CheckDimensions(size_t actual, size_t expected) {
|
|
| 51 |
if (actual != expected) {
|
|
| 52 |
return false; |
|
| 53 |
} |
|
| 54 | ||
| 55 |
return true; |
|
| 56 |
} |
|
| 57 | ||
| 58 |
}; |
|
| 59 | ||
| 60 |
} // namespace fims_model_object |
|
| 61 | ||
| 62 |
#endif /* FIMS_COMMON_MODEL_OBJECT_HPP */ |
| 1 |
/** |
|
| 2 |
* @file ewaa.hpp |
|
| 3 |
* @brief Declares the growth functor class which is the base class for all |
|
| 4 |
* growth functors. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef POPULATION_DYNAMICS_GROWTH_EWAA_HPP |
|
| 10 |
#define POPULATION_DYNAMICS_GROWTH_EWAA_HPP |
|
| 11 | ||
| 12 |
//#include "../../../interface/interface.hpp" |
|
| 13 |
#include <map> |
|
| 14 | ||
| 15 |
#include "growth_base.hpp" |
|
| 16 | ||
| 17 |
namespace fims_popdy {
|
|
| 18 | ||
| 19 |
/** |
|
| 20 |
* @brief EWAAgrowth class that returns the EWAA function value. |
|
| 21 |
*/ |
|
| 22 |
template <typename Type> |
|
| 23 |
struct EWAAgrowth : public GrowthBase<Type> {
|
|
| 24 |
// add submodule class members here |
|
| 25 |
// these include parameters of the submodule |
|
| 26 |
// a map looks up values based on a reference key |
|
| 27 |
// in this case, our key is age (first double), and |
|
| 28 |
// the value is the weight at that age (second double) |
|
| 29 |
std::map<double, double> ewaa; /**<map of doubles for EWAA values by age, |
|
| 30 |
where age starts at zero > */ |
|
| 31 |
typedef typename std::map<double, double>::iterator weight_iterator; /**< Iterator for ewaa map object > */ |
|
| 32 | ||
| 33 | 98x |
EWAAgrowth() : GrowthBase<Type>() {}
|
| 34 | ||
| 35 | 98x |
virtual ~EWAAgrowth() {}
|
| 36 | ||
| 37 |
/** |
|
| 38 |
* @brief Returns the weight at age a (in kg) from the input vector. |
|
| 39 |
* |
|
| 40 |
* @param a age of the fish, the age vector must start at zero |
|
| 41 |
*/ |
|
| 42 | 3165x |
virtual const Type evaluate(const double& a) {
|
| 43 | 3165x |
weight_iterator it = this->ewaa.find(a); |
| 44 | 3165x |
if(it == this->ewaa.end() ){
|
| 45 | 3x |
return 0.0; |
| 46 |
} |
|
| 47 | 3162x |
Type ret = (*it).second;//itewaa[a]; |
| 48 | 3162x |
return ret; |
| 49 |
} |
|
| 50 |
}; |
|
| 51 |
} // namespace fims_popdy |
|
| 52 |
#endif /* POPULATION_DYNAMICS_GROWTH_EWAA_HPP */ |
| 1 |
/** |
|
| 2 |
* @file growth_base.hpp |
|
| 3 |
* @brief Includes any .hpp files within the subfolders so that only this file |
|
| 4 |
* needs to included in the model.hpp file. |
|
| 5 |
* @details Defines guards for growth module outline to define the |
|
| 6 |
* module_name_base hpp file if not already defined. |
|
| 7 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 8 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 9 |
* folder for reuse information. |
|
| 10 |
*/ |
|
| 11 |
#ifndef POPULATION_DYNAMICS_GROWTH_BASE_HPP |
|
| 12 |
#define POPULATION_DYNAMICS_GROWTH_BASE_HPP |
|
| 13 | ||
| 14 |
#include "../../../common/model_object.hpp" |
|
| 15 | ||
| 16 |
namespace fims_popdy {
|
|
| 17 | ||
| 18 |
/** |
|
| 19 |
* @brief Base class for all growth functors. |
|
| 20 |
* |
|
| 21 |
* @tparam Type The type of the growth functor. |
|
| 22 |
*/ |
|
| 23 |
template <typename Type> |
|
| 24 |
struct GrowthBase : public fims_model_object::FIMSObject<Type> {
|
|
| 25 |
// id_g is the ID of the instance of the growthBase class. |
|
| 26 |
// this is like a memory tracker. |
|
| 27 |
// Assigning each one its own ID is a way to keep track of |
|
| 28 |
// all the instances of the growthBase class. |
|
| 29 |
static uint32_t id_g; /**< reference id for growth object*/ |
|
| 30 | ||
| 31 |
/** |
|
| 32 |
* @brief Constructor. |
|
| 33 |
*/ |
|
| 34 | 49x |
GrowthBase() { this->id = GrowthBase::id_g++; }
|
| 35 | ||
| 36 | 49x |
virtual ~GrowthBase() {}
|
| 37 | ||
| 38 |
/** |
|
| 39 |
* @brief Calculates the growth at the independent variable value. |
|
| 40 |
* @param a The age at which to return weight of the fish (in kg). |
|
| 41 |
*/ |
|
| 42 |
virtual const Type evaluate(const double& a) = 0; |
|
| 43 |
}; |
|
| 44 | ||
| 45 |
template <typename Type> |
|
| 46 |
uint32_t GrowthBase<Type>::id_g = 0; |
|
| 47 | ||
| 48 |
} // namespace fims_popdy |
|
| 49 | ||
| 50 |
#endif /* POPULATION_DYNAMICS_GROWTH_BASE_HPP */ |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/growth/functors/ewaa.hpp" |
|
| 3 | ||
| 4 |
namespace |
|
| 5 |
{
|
|
| 6 | 25x |
TEST(GrowthEvaluate, IntegerAgeInput) |
| 7 |
{
|
|
| 8 |
// empirical weight-at-age values from the model comparison project |
|
| 9 |
// (via the Rdata object being used by the data group) |
|
| 10 |
// ewaa(a = 0): 0.0 |
|
| 11 |
// ewaa(a = 1): 0.0005306555 |
|
| 12 |
// ewaa(a = 2): 0.0011963283 |
|
| 13 | ||
| 14 |
// create a new ewaa singleton class |
|
| 15 | 3x |
fims_popdy::EWAAgrowth<double> ewaa1; |
| 16 |
// set the ewaa values using an initializer list |
|
| 17 |
// std::pair is a class template that provides a way to store two heterogeneous objects as a single unit |
|
| 18 | 3x |
ewaa1.ewaa = |
| 19 | 3x |
std::map<double, double>{std::pair<double, double>(0.0, 0.0),
|
| 20 |
std::pair<double, double>(1.0, 0.005306555), |
|
| 21 |
std::pair<double, double>(2.0, 0.0011963283)}; |
|
| 22 |
// set the expected values |
|
| 23 | 3x |
std::map<double, double> expect_ewaa0 = std::map<double, double>{std::pair<double, double>(0.0, 0.0),
|
| 24 |
std::pair<double, double>(1.0, 0.005306555), |
|
| 25 |
std::pair<double, double>(2.0, 0.0011963283)}; |
|
| 26 |
// test the values at ages 0, 1, and 2 |
|
| 27 | 3x |
EXPECT_EQ(ewaa1.evaluate(0), expect_ewaa0[0]); |
| 28 | ||
| 29 |
// test that the id of the singleton class is set correctly |
|
| 30 | 3x |
EXPECT_EQ(ewaa1.GetId(), 0); |
| 31 |
} |
|
| 32 | ||
| 33 | 25x |
TEST(GrowthEvaluate, DoubleAgeInput) |
| 34 |
{
|
|
| 35 |
// create a new ewaa singleton class |
|
| 36 | 3x |
fims_popdy::EWAAgrowth<double> ewaa2; |
| 37 |
// set the ewaa values |
|
| 38 | 3x |
ewaa2.ewaa = |
| 39 | 3x |
std::map<double, double>{std::pair<double, double>(0.0, 0.0),
|
| 40 |
std::pair<double, double>(1.0, 0.005306555), |
|
| 41 |
std::pair<double, double>(2.0, 0.0011963283)}; |
|
| 42 | ||
| 43 |
std::map<double, double> expect_ewaa2 = |
|
| 44 | 3x |
{std::pair<double, double>(0.0, 0.0),
|
| 45 |
std::pair<double, double>(1.0, 0.005306555), |
|
| 46 |
std::pair<double, double>(2.0, 0.0011963283)}; |
|
| 47 |
// test the values at ages 1.5, which isn't yet implemented |
|
| 48 |
// so should fail |
|
| 49 | 3x |
EXPECT_EQ(ewaa2.evaluate(1.5), 0.0); |
| 50 |
// test that the id of the singleton class is set correctly |
|
| 51 |
// this is zero because we are running it in a different test case than above |
|
| 52 | 3x |
EXPECT_EQ(ewaa2.GetId(), 0); |
| 53 |
} |
|
| 54 |
} |
| 1 |
/** |
|
| 2 |
* @file fims_vector.hpp |
|
| 3 |
* @brief TODO: provide a brief description. |
|
| 4 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 5 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 6 |
* folder for reuse information. |
|
| 7 |
*/ |
|
| 8 |
#ifndef FIMS_VECTOR_HPP |
|
| 9 |
#define FIMS_VECTOR_HPP |
|
| 10 | ||
| 11 |
#include "../interface/interface.hpp" |
|
| 12 |
#include <ostream> |
|
| 13 |
namespace fims {
|
|
| 14 | ||
| 15 |
/** |
|
| 16 |
* Wrapper class for std::vector types. If this file is compiled with |
|
| 17 |
* -DTMB_MODEL, conversion operators are defined for TMB vector types. |
|
| 18 |
* |
|
| 19 |
* All std::vector functions are copied over from the std library. While some of |
|
| 20 |
* these may not be called explicitly in FIMS, they may be required to run other |
|
| 21 |
* std library functions. |
|
| 22 |
* |
|
| 23 |
*/ |
|
| 24 |
template <typename Type> |
|
| 25 |
class Vector {
|
|
| 26 |
std::vector<Type> vec_m; |
|
| 27 | ||
| 28 |
/** |
|
| 29 |
* @brief friend comparison operator. Allows the operartor to see private |
|
| 30 |
* members of fims::Vector<Type>. |
|
| 31 |
*/ |
|
| 32 |
template <typename T> |
|
| 33 |
friend bool operator==(const fims::Vector<T>& lhs, |
|
| 34 |
const fims::Vector<T>& rhs); |
|
| 35 | ||
| 36 |
public: |
|
| 37 |
// Member Types |
|
| 38 | ||
| 39 |
typedef |
|
| 40 |
typename std::vector<Type>::value_type value_type; /*!<Member type Type>*/ |
|
| 41 |
typedef typename std::vector<Type>::allocator_type |
|
| 42 |
allocator_type; /*!<Allocator for type Type>*/ |
|
| 43 |
typedef typename std::vector<Type>::size_type size_type; /*!<Size type>*/ |
|
| 44 |
typedef typename std::vector<Type>::difference_type |
|
| 45 |
difference_type; /*!<Difference type>*/ |
|
| 46 |
typedef typename std::vector<Type>::reference |
|
| 47 |
reference; /*!<Reference type &Type>*/ |
|
| 48 |
typedef typename std::vector<Type>::const_reference |
|
| 49 |
const_reference; /*!<Constant eference type const &Type>*/ |
|
| 50 |
typedef typename std::vector<Type>::pointer pointer; /*!<Pointer type Type*>*/ |
|
| 51 |
typedef typename std::vector<Type>::const_pointer |
|
| 52 |
const_pointer; /*!<Constant ointer type const Type*>*/ |
|
| 53 |
typedef typename std::vector<Type>::iterator iterator; /*!<Iterator>*/ |
|
| 54 |
typedef typename std::vector<Type>::const_iterator |
|
| 55 |
const_iterator; /*!<Constant iterator>*/ |
|
| 56 |
typedef typename std::vector<Type>::reverse_iterator |
|
| 57 |
reverse_iterator; /*!<Reverse iterator>*/ |
|
| 58 |
typedef typename std::vector<Type>::const_reverse_iterator |
|
| 59 |
const_reverse_iterator; /*!<Constant reverse iterator>*/ |
|
| 60 | ||
| 61 |
// Constructors |
|
| 62 | ||
| 63 |
/** |
|
| 64 |
* Default constructor. |
|
| 65 |
*/ |
|
| 66 | 6948x |
Vector() |
| 67 |
{
|
|
| 68 |
} |
|
| 69 | ||
| 70 |
/** |
|
| 71 |
* @brief Constructs a Vector of length "size" and sets the elements with the |
|
| 72 |
* value from input "value". |
|
| 73 |
*/ |
|
| 74 | 2840x |
Vector(size_t size, const Type& value = Type()) |
| 75 |
{
|
|
| 76 | 1420x |
this->vec_m.resize(size, value); |
| 77 |
} |
|
| 78 | ||
| 79 |
/** |
|
| 80 |
* @brief Copy constructor. |
|
| 81 |
*/ |
|
| 82 | ! |
Vector(const Vector<Type>& other) |
| 83 |
{
|
|
| 84 | ! |
this->vec_m.resize(other.size()); |
| 85 | ! |
for (size_t i = 0; i < this->vec_m.size(); i++) {
|
| 86 | ! |
this->vec_m[i] = other[i]; |
| 87 |
} |
|
| 88 |
} |
|
| 89 | ||
| 90 |
/** |
|
| 91 |
* @brief Initialization constructor from std::vector<Type> type. |
|
| 92 |
*/ |
|
| 93 | 8x |
Vector(const std::vector<Type>& other) |
| 94 |
{
|
|
| 95 | 4x |
this->vec_m = other; |
| 96 |
} |
|
| 97 | ||
| 98 |
// TMB specific constructor |
|
| 99 |
#ifdef TMB_MODEL |
|
| 100 | ||
| 101 |
/** |
|
| 102 |
* @brief Initialization constructor from tmbutils::vector<Type> type. |
|
| 103 |
*/ |
|
| 104 |
Vector(const tmbutils::vector<Type>& other) |
|
| 105 |
{
|
|
| 106 |
this->vec_m.resize(other.size()); |
|
| 107 |
for (size_t i = 0; i < this->vec_m.size(); i++) {
|
|
| 108 |
this->vec_m[i] = other[i]; |
|
| 109 |
} |
|
| 110 |
} |
|
| 111 | ||
| 112 |
#endif |
|
| 113 | ||
| 114 |
/** |
|
| 115 |
* The following are std::vector functions copied over from the standard |
|
| 116 |
* library. While some of these may not be called explicitly in FIMS, they may |
|
| 117 |
* be required to run other std library functions. |
|
| 118 |
*/ |
|
| 119 | ||
| 120 |
/** |
|
| 121 |
* @brief Returns a reference to the element at specified location pos. No |
|
| 122 |
* bounds checking is performed. |
|
| 123 |
*/ |
|
| 124 | 288653x |
inline Type& operator[](size_t pos) |
| 125 |
{
|
|
| 126 | 288653x |
return this->vec_m[pos]; |
| 127 |
} |
|
| 128 | ||
| 129 |
/** |
|
| 130 |
* @brief Returns a constant reference to the element at specified location |
|
| 131 |
* pos. No bounds checking is performed. |
|
| 132 |
*/ |
|
| 133 | ! |
inline const Type& operator[](size_t n) const |
| 134 |
{
|
|
| 135 | ! |
return this->vec_m[n]; |
| 136 |
} |
|
| 137 | ||
| 138 |
/** |
|
| 139 |
* @brief Returns a reference to the element at specified location pos. Bounds |
|
| 140 |
* checking is performed. |
|
| 141 |
*/ |
|
| 142 | 1443x |
inline Type& at(size_t n) |
| 143 |
{
|
|
| 144 | 1443x |
return this->vec_m.at(n); |
| 145 |
} |
|
| 146 | ||
| 147 |
/** |
|
| 148 |
* @brief Returns a constant reference to the element at specified location |
|
| 149 |
* pos. Bounds checking is performed. |
|
| 150 |
*/ |
|
| 151 |
inline const Type& at(size_t n) const |
|
| 152 |
{
|
|
| 153 |
return this->vec_m.at(n); |
|
| 154 |
} |
|
| 155 | ||
| 156 |
/** |
|
| 157 |
* @brief If this vector is size 1 and pos is greater than zero, |
|
| 158 |
* the first index is returned. If this vector has size |
|
| 159 |
* greater than 1 and pos is greater than size, a invalid_argument |
|
| 160 |
* exception is thrown. Otherwise, the value at index pos is returned. |
|
| 161 |
* |
|
| 162 |
* @param pos |
|
| 163 |
* @return a constant reference to the element at specified location |
|
| 164 |
*/ |
|
| 165 | 1443x |
inline Type& get_force_scalar(size_t pos) |
| 166 |
{
|
|
| 167 | 1443x |
if (this->size() == 1 && pos > 0) {
|
| 168 | 1395x |
return this->at(0); |
| 169 | 48x |
} else if (this->size() > 1 && pos >= this->size()) {
|
| 170 | ! |
throw std::invalid_argument("force_get fims::Vector index out of bounds.");
|
| 171 |
} else {
|
|
| 172 | 48x |
return this->at(pos); |
| 173 |
} |
|
| 174 |
} |
|
| 175 | ||
| 176 |
/** |
|
| 177 |
* @brief Returns a reference to the first element in the container. |
|
| 178 |
*/ |
|
| 179 |
inline reference front() |
|
| 180 |
{
|
|
| 181 |
return this->vec_m.front(); |
|
| 182 |
} |
|
| 183 | ||
| 184 |
/** |
|
| 185 |
* @brief Returns a constant reference to the first element in the container. |
|
| 186 |
*/ |
|
| 187 |
inline const_reference front() const |
|
| 188 |
{
|
|
| 189 |
return this->vec_m.front(); |
|
| 190 |
} |
|
| 191 | ||
| 192 |
/** |
|
| 193 |
* @brief Returns a reference to the last element in the container. |
|
| 194 |
*/ |
|
| 195 |
inline reference back() |
|
| 196 |
{
|
|
| 197 |
return this->vec_m.back(); |
|
| 198 |
} |
|
| 199 | ||
| 200 |
/** |
|
| 201 |
* @brief Returns a constant reference to the last element in the container. |
|
| 202 |
*/ |
|
| 203 |
inline const_reference back() const |
|
| 204 |
{
|
|
| 205 |
return this->vec_m.back(); |
|
| 206 |
} |
|
| 207 | ||
| 208 |
/** |
|
| 209 |
* @brief Returns a pointer to the underlying data array. |
|
| 210 |
*/ |
|
| 211 |
inline pointer data() |
|
| 212 |
{
|
|
| 213 |
return this->vec_m.data(); |
|
| 214 |
} |
|
| 215 | ||
| 216 |
/** |
|
| 217 |
* @brief Returns a constant pointer to the underlying data array. |
|
| 218 |
*/ |
|
| 219 |
inline const_pointer data() const |
|
| 220 |
{
|
|
| 221 |
return this->vec_m.data(); |
|
| 222 |
} |
|
| 223 | ||
| 224 |
// iterators |
|
| 225 | ||
| 226 |
/** |
|
| 227 |
* @brief Returns an iterator to the first element of the vector. |
|
| 228 |
*/ |
|
| 229 | 2392x |
inline iterator begin() |
| 230 |
{
|
|
| 231 | 2392x |
return this->vec_m.begin(); |
| 232 |
} |
|
| 233 | ||
| 234 |
/** |
|
| 235 |
* @brief Returns an iterator to the element following the last element of the |
|
| 236 |
* vector. |
|
| 237 |
*/ |
|
| 238 | 2392x |
inline iterator end() |
| 239 |
{
|
|
| 240 | 2392x |
return this->vec_m.end(); |
| 241 |
} |
|
| 242 | ||
| 243 |
/** |
|
| 244 |
* @brief Returns a reverse iterator to the first element of the reversed |
|
| 245 |
* vector. It corresponds to the last element of the non-reversed vector. |
|
| 246 |
*/ |
|
| 247 |
inline reverse_iterator rbegin() |
|
| 248 |
{
|
|
| 249 |
return this->vec_m.rbegin(); |
|
| 250 |
} |
|
| 251 | ||
| 252 |
/** |
|
| 253 |
* @brief Returns a reverse iterator to the element following the last element |
|
| 254 |
* of the reversed vector. It corresponds to the element preceding the first |
|
| 255 |
* element of the non-reversed vector. |
|
| 256 |
*/ |
|
| 257 |
inline reverse_iterator rend() |
|
| 258 |
{
|
|
| 259 |
return this->vec_m.rend(); |
|
| 260 |
} |
|
| 261 | ||
| 262 |
/** |
|
| 263 |
* @brief Returns a constant reverse iterator to the first element of the |
|
| 264 |
* reversed vector. It corresponds to the last element of the non-reversed |
|
| 265 |
* vector. |
|
| 266 |
*/ |
|
| 267 |
inline const_reverse_iterator rbegin() const |
|
| 268 |
{
|
|
| 269 |
return this->vec_m.rbegin(); |
|
| 270 |
} |
|
| 271 | ||
| 272 |
/** |
|
| 273 |
* @brief Returns a constant reverse iterator to the element following the |
|
| 274 |
* last element of the reversed vector. It corresponds to the element |
|
| 275 |
* preceding the first element of the non-reversed vector. |
|
| 276 |
*/ |
|
| 277 |
inline const_reverse_iterator rend() const |
|
| 278 |
{
|
|
| 279 |
return this->vec_m.rend(); |
|
| 280 |
} |
|
| 281 | ||
| 282 |
// capacity |
|
| 283 | ||
| 284 |
/** |
|
| 285 |
* @brief Checks whether the container is empty. |
|
| 286 |
*/ |
|
| 287 |
inline bool empty() |
|
| 288 |
{
|
|
| 289 |
return this->vec_m.empty(); |
|
| 290 |
} |
|
| 291 | ||
| 292 |
/** |
|
| 293 |
* @brief Returns the number of elements. |
|
| 294 |
*/ |
|
| 295 | 6125x |
inline size_type size() const |
| 296 |
{
|
|
| 297 | 6125x |
return this->vec_m.size(); |
| 298 |
} |
|
| 299 | ||
| 300 |
/** |
|
| 301 |
* @brief Returns the maximum possible number of elements. |
|
| 302 |
*/ |
|
| 303 |
inline size_type max_size() const |
|
| 304 |
{
|
|
| 305 |
return this->vec_m.max_size(); |
|
| 306 |
} |
|
| 307 | ||
| 308 |
/** |
|
| 309 |
* @brief Reserves storage. |
|
| 310 |
*/ |
|
| 311 |
inline void reserve(size_type cap) |
|
| 312 |
{
|
|
| 313 |
this->vec_m.reserve(cap); |
|
| 314 |
} |
|
| 315 | ||
| 316 |
/** |
|
| 317 |
* @brief Returns the number of elements that can be held in currently |
|
| 318 |
* allocated storage. |
|
| 319 |
*/ |
|
| 320 |
inline size_type capacity() |
|
| 321 |
{
|
|
| 322 |
return this->vec_m.capacity(); |
|
| 323 |
} |
|
| 324 | ||
| 325 |
/** |
|
| 326 |
* @brief Reduces memory usage by freeing unused memory. |
|
| 327 |
*/ |
|
| 328 |
inline void shrink_to_fit() |
|
| 329 |
{
|
|
| 330 |
this->vec_m.shrink_to_fit(); |
|
| 331 |
} |
|
| 332 | ||
| 333 |
// modifiers |
|
| 334 | ||
| 335 |
/** |
|
| 336 |
* @brief Clears the contents. |
|
| 337 |
*/ |
|
| 338 |
inline void clear() |
|
| 339 |
{
|
|
| 340 |
this->vec_m.clear(); |
|
| 341 |
} |
|
| 342 | ||
| 343 |
/** |
|
| 344 |
* @brief Inserts value before pos. |
|
| 345 |
*/ |
|
| 346 |
inline iterator insert(const_iterator pos, const Type& value) |
|
| 347 |
{
|
|
| 348 |
return this->vec_m.insert(pos, value); |
|
| 349 |
} |
|
| 350 | ||
| 351 |
/** |
|
| 352 |
* @brief Inserts count copies of the value before pos. |
|
| 353 |
*/ |
|
| 354 |
inline iterator insert(const_iterator pos, size_type count, |
|
| 355 |
const Type& value) |
|
| 356 |
{
|
|
| 357 |
return this->vec_m.insert(pos, count, value); |
|
| 358 |
} |
|
| 359 | ||
| 360 |
/** |
|
| 361 |
* @brief Inserts elements from range [first, last) before pos. |
|
| 362 |
*/ |
|
| 363 |
template <class InputIt> |
|
| 364 | ! |
iterator insert(const_iterator pos, InputIt first, InputIt last) |
| 365 |
{
|
|
| 366 | ! |
return this->vec_m.insert(pos, first, last); |
| 367 |
} |
|
| 368 | ||
| 369 |
/** |
|
| 370 |
* @brief Inserts elements from initializer list ilist before pos. |
|
| 371 |
*/ |
|
| 372 | ||
| 373 |
iterator insert(const_iterator pos, std::initializer_list<Type> ilist) |
|
| 374 |
{
|
|
| 375 |
return this->vec_m.insert(pos, ilist); |
|
| 376 |
} |
|
| 377 | ||
| 378 |
/** |
|
| 379 |
* @brief Constructs element in-place. |
|
| 380 |
*/ |
|
| 381 |
template <class... Args> |
|
| 382 |
iterator emplace(const_iterator pos, Args&&... args) |
|
| 383 |
{
|
|
| 384 |
return this->vec_m.emplace(pos, std::forward<Args>(args)...); |
|
| 385 |
} |
|
| 386 | ||
| 387 |
/** |
|
| 388 |
* @brief Removes the element at pos. |
|
| 389 |
*/ |
|
| 390 |
inline iterator erase(iterator pos) |
|
| 391 |
{
|
|
| 392 |
return this->vec_m.erase(pos); |
|
| 393 |
} |
|
| 394 | ||
| 395 |
/** |
|
| 396 |
* @brief Removes the elements in the range [first, last). |
|
| 397 |
*/ |
|
| 398 |
inline iterator erase(iterator first, iterator last) |
|
| 399 |
{
|
|
| 400 |
return this->vec_m.erase(first, last); |
|
| 401 |
} |
|
| 402 | ||
| 403 |
/** |
|
| 404 |
* @brief Adds an element to the end. |
|
| 405 |
*/ |
|
| 406 |
inline void push_back(const Type&& value) |
|
| 407 |
{
|
|
| 408 |
this->vec_m.push_back(value); |
|
| 409 |
} |
|
| 410 | ||
| 411 |
/** |
|
| 412 |
* @brief Constructs an element in-place at the end. |
|
| 413 |
*/ |
|
| 414 |
template <class... Args> |
|
| 415 |
void emplace_back(Args&&... args) |
|
| 416 |
{
|
|
| 417 |
this->vec_m.emplace_back(std::forward<Args>(args)...); |
|
| 418 |
} |
|
| 419 | ||
| 420 |
/** |
|
| 421 |
* @brief Removes the last element. |
|
| 422 |
*/ |
|
| 423 |
inline void pop_back() |
|
| 424 |
{
|
|
| 425 |
this->vec_m.pop_back(); |
|
| 426 |
} |
|
| 427 | ||
| 428 |
/** |
|
| 429 |
* @brief Changes the number of elements stored. |
|
| 430 |
*/ |
|
| 431 | 3052x |
inline void resize(size_t s) |
| 432 |
{
|
|
| 433 | 3052x |
this->vec_m.resize(s); |
| 434 |
} |
|
| 435 | ||
| 436 |
/** |
|
| 437 |
* @brief Swaps the contents. |
|
| 438 |
*/ |
|
| 439 |
inline void swap(Vector& other) |
|
| 440 |
{
|
|
| 441 |
this->vec_m.swap(other.vec_m); |
|
| 442 |
} |
|
| 443 | ||
| 444 |
// end std::vector functions |
|
| 445 | ||
| 446 |
/** |
|
| 447 |
* Conversion operators |
|
| 448 |
*/ |
|
| 449 | ||
| 450 |
/** |
|
| 451 |
* @brief Converts fims::Vector<Type> to std::vector<Type> |
|
| 452 |
*/ |
|
| 453 | 4x |
inline operator std::vector<Type>() |
| 454 |
{
|
|
| 455 | 4x |
return this->vec_m; |
| 456 |
} |
|
| 457 | ||
| 458 |
#ifdef TMB_MODEL |
|
| 459 | ||
| 460 |
/** |
|
| 461 |
* @brief Converts fims::Vector<Type> to tmbutils::vector<Type>const |
|
| 462 |
*/ |
|
| 463 | ! |
operator tmbutils::vector<Type>() const |
| 464 |
{
|
|
| 465 | ! |
tmbutils::vector<Type> ret; |
| 466 | ! |
ret.resize(this->vec_m.size()); |
| 467 | ! |
for (size_t i = 0; i < this->vec_m.size(); i++) {
|
| 468 | ! |
ret[i] = this->vec_m[i]; |
| 469 |
} |
|
| 470 | ! |
return ret; |
| 471 |
} |
|
| 472 | ||
| 473 |
/** |
|
| 474 |
* @brief Converts fims::Vector<Type> to tmbutils::vector<Type> |
|
| 475 |
*/ |
|
| 476 | ! |
operator tmbutils::vector<Type>() |
| 477 |
{
|
|
| 478 | ! |
tmbutils::vector<Type> ret; |
| 479 | ! |
ret.resize(this->vec_m.size()); |
| 480 | ! |
for (size_t i = 0; i < this->vec_m.size(); i++) {
|
| 481 | ! |
ret[i] = this->vec_m[i]; |
| 482 |
} |
|
| 483 | ! |
return ret; |
| 484 |
} |
|
| 485 | ||
| 486 |
#endif |
|
| 487 | ||
| 488 |
private: |
|
| 489 |
}; // end fims::Vector class |
|
| 490 | ||
| 491 |
/** |
|
| 492 |
* @brief Comparison operator. |
|
| 493 |
*/ |
|
| 494 |
template <class T> |
|
| 495 | 1356x |
bool operator==(const fims::Vector<T>& lhs, const fims::Vector<T>& rhs) {
|
| 496 | 1356x |
return lhs.vec_m == rhs.vec_m; |
| 497 |
} |
|
| 498 | ||
| 499 |
} // namespace fims |
|
| 500 | ||
| 501 |
/** |
|
| 502 |
* @brief Output for std::ostream& for a vector. |
|
| 503 |
* |
|
| 504 |
* @param out The stream. |
|
| 505 |
* @param v A vector. |
|
| 506 |
* @return std::ostream& |
|
| 507 |
*/ |
|
| 508 |
template<typename Type> |
|
| 509 | 4x |
std::ostream& operator<<(std::ostream& out, fims::Vector<Type>& v) {
|
| 510 | 4x |
out << "["; |
| 511 | ||
| 512 | 4x |
if (v.size() == 0) {
|
| 513 | ! |
out << "]"; |
| 514 | ! |
return out; |
| 515 |
} |
|
| 516 | 4x |
for (size_t i = 0; i < v.size() - 1; i++) {
|
| 517 | ! |
out << v[i] << ","; |
| 518 |
} |
|
| 519 | ||
| 520 | 4x |
out << v[v.size() - 1] << "]"; |
| 521 | 4x |
return out; |
| 522 |
} |
|
| 523 | ||
| 524 | ||
| 525 |
#endif |
| 1 |
/** |
|
| 2 |
* @file fleet.hpp |
|
| 3 |
* @brief Declare the fleet functor class which is the base class for all fleet |
|
| 4 |
* functors. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef FIMS_POPULATION_DYNAMICS_FLEET_HPP |
|
| 10 |
#define FIMS_POPULATION_DYNAMICS_FLEET_HPP |
|
| 11 | ||
| 12 |
#include "../../common/data_object.hpp" |
|
| 13 |
#include "../../common/fims_vector.hpp" |
|
| 14 |
#include "../../common/model_object.hpp" |
|
| 15 |
#include "../../distributions/distributions.hpp" |
|
| 16 |
#include "../selectivity/selectivity.hpp" |
|
| 17 | ||
| 18 |
namespace fims_popdy {
|
|
| 19 | ||
| 20 |
/** @brief Base class for all fleets. |
|
| 21 |
* |
|
| 22 |
* @tparam Type The type of the fleet object. |
|
| 23 |
*/ |
|
| 24 |
template <class Type> |
|
| 25 |
struct Fleet : public fims_model_object::FIMSObject<Type> {
|
|
| 26 |
static uint32_t id_g; /*!< reference id for fleet object*/ |
|
| 27 |
size_t nyears; /*!< the number of years in the model*/ |
|
| 28 |
size_t nages; /*!< the number of ages in the model*/ |
|
| 29 |
size_t nlengths; /*!< the number of lengths in the model*/ |
|
| 30 | ||
| 31 |
// selectivity |
|
| 32 | 104x |
int fleet_selectivity_id_m = -999; /*!< id of selectivity component*/ |
| 33 |
std::shared_ptr<SelectivityBase<Type>> |
|
| 34 |
selectivity; /*!< selectivity component*/ |
|
| 35 | ||
| 36 |
// index data |
|
| 37 | 104x |
int fleet_observed_index_data_id_m = -999; /*!< id of index data */ |
| 38 |
std::shared_ptr<fims_data_object::DataObject<Type>> |
|
| 39 |
observed_index_data; /*!< observed index data*/ |
|
| 40 | ||
| 41 |
// age comp data |
|
| 42 | 104x |
int fleet_observed_agecomp_data_id_m = -999; /*!< id of age comp data */ |
| 43 |
std::shared_ptr<fims_data_object::DataObject<Type>> |
|
| 44 |
observed_agecomp_data; /*!< observed agecomp data*/ |
|
| 45 | ||
| 46 |
// length comp data |
|
| 47 | 104x |
int fleet_observed_lengthcomp_data_id_m = -999; /*!< id of length comp data */ |
| 48 |
std::shared_ptr<fims_data_object::DataObject<Type>> |
|
| 49 |
observed_lengthcomp_data; /*!< observed lengthcomp data*/ |
|
| 50 | ||
| 51 |
// Mortality and catchability |
|
| 52 |
fims::Vector<Type> |
|
| 53 |
log_Fmort; /*!< estimated parameter: log Fishing mortality*/ |
|
| 54 |
fims::Vector<Type> log_q; /*!< estimated parameter: catchability of the fleet */ |
|
| 55 | ||
| 56 |
fims::Vector<Type> Fmort; /*!< transformed parameter: Fishing mortality*/ |
|
| 57 |
fims::Vector<Type> q; /*!< transformed parameter: the catchability of the fleet */ |
|
| 58 | ||
| 59 |
// derived quantities |
|
| 60 |
fims::Vector<Type> catch_at_age; /*!<derived quantity catch at age*/ |
|
| 61 |
fims::Vector<Type> catch_index; /*!<derived quantity catch index*/ |
|
| 62 |
fims::Vector<Type> age_composition; /*!<derived quantity age composition*/ |
|
| 63 |
fims::Vector<Type> length_composition; /*!<derived quantity length composition*/ |
|
| 64 |
fims::Vector<Type> age_length_conversion_matrix; /*!<derived quantity age-length transition matrix*/ |
|
| 65 | ||
| 66 |
// derived quantities |
|
| 67 |
fims::Vector<Type> observed_catch_lpdf; /*!<observed total catch linked |
|
| 68 |
to log probability density function*/ |
|
| 69 |
fims::Vector<Type> observed_index_lpdf; /*!<observed index of abundance linked |
|
| 70 |
to log probability density function*/ |
|
| 71 |
fims::Vector<Type> expected_catch; /*!<model expected total catch*/ |
|
| 72 |
fims::Vector<Type> expected_index; /*!<model expected index of abundance*/ |
|
| 73 |
fims::Vector<Type> log_expected_index; /*!<model expected index of abundance*/ |
|
| 74 |
fims::Vector<Type> expected_catch_lpdf; /*!<model expected total catch linked |
|
| 75 |
to log probability density function*/ |
|
| 76 |
fims::Vector<Type> expected_index_lpdf; /*!<model expected index of abundance linked |
|
| 77 |
to log probability density function*/ |
|
| 78 |
fims::Vector<Type> catch_numbers_at_age; /*!<model expected catch at age*/ |
|
| 79 |
fims::Vector<Type> catch_numbers_at_length; /*!<model expected catch at length*/ |
|
| 80 |
fims::Vector<Type> proportion_catch_numbers_at_age; /*!<model expected catch at age*/ |
|
| 81 |
fims::Vector<Type> proportion_catch_numbers_at_length; /*!<model expected catch at length*/ |
|
| 82 |
fims::Vector<Type> catch_weight_at_age; /*!<model expected weight at age*/ |
|
| 83 | 104x |
bool is_survey = false; /*!< is this fleet object a survey*/ |
| 84 | ||
| 85 |
#ifdef TMB_MODEL |
|
| 86 |
::objective_function<Type> *of; |
|
| 87 |
#endif |
|
| 88 | ||
| 89 |
/** |
|
| 90 |
* @brief Constructor. |
|
| 91 |
*/ |
|
| 92 | 624x |
Fleet() {
|
| 93 | 104x |
this->id = Fleet::id_g++; |
| 94 |
} |
|
| 95 | ||
| 96 |
/** |
|
| 97 |
* @brief Destructor. |
|
| 98 |
*/ |
|
| 99 | 208x |
virtual ~Fleet() {
|
| 100 |
} |
|
| 101 | ||
| 102 |
/** |
|
| 103 |
* @brief Intialize Fleet Class |
|
| 104 |
* @param nyears The number of years in the model. |
|
| 105 |
* @param nages The number of ages in the model. |
|
| 106 |
* @param nlengths The number of lengths in the model. |
|
| 107 |
*/ |
|
| 108 | 92x |
void Initialize(int nyears, int nages, int nlengths = 0) {
|
| 109 | 92x |
if (this->log_q.size() == 0) {
|
| 110 | 3x |
this->log_q.resize(1); |
| 111 | 3x |
this->log_q[0] = 0.0; |
| 112 |
} |
|
| 113 | 92x |
this->nyears = nyears; |
| 114 | 92x |
this->nages = nages; |
| 115 | 92x |
this->nlengths = nlengths; |
| 116 | ||
| 117 | 92x |
catch_at_age.resize(nyears * nages); |
| 118 | 92x |
catch_numbers_at_age.resize(nyears * nages); |
| 119 | 92x |
catch_numbers_at_length.resize(nyears * nlengths); |
| 120 | 92x |
proportion_catch_numbers_at_age.resize(nyears * nages); |
| 121 | 92x |
proportion_catch_numbers_at_length.resize(nyears * nlengths); |
| 122 | 92x |
age_length_conversion_matrix.resize(nages * nlengths); |
| 123 | 92x |
catch_weight_at_age.resize(nyears * nages); |
| 124 | 92x |
catch_index.resize(nyears); // assume index is for all ages. |
| 125 | 92x |
expected_catch.resize(nyears); |
| 126 | 92x |
expected_index.resize(nyears); |
| 127 | 92x |
log_expected_index.resize(nyears); |
| 128 | 92x |
age_composition.resize(nyears * nages); |
| 129 | 92x |
length_composition.resize(nyears * nlengths); |
| 130 | 92x |
q.resize(this->log_q.size()); |
| 131 | 92x |
log_Fmort.resize(nyears); |
| 132 | 92x |
Fmort.resize(nyears); |
| 133 |
} |
|
| 134 | ||
| 135 |
/** |
|
| 136 |
* @brief Prepare to run the fleet module. Called at each model |
|
| 137 |
* iteration, and used to exponentiate the natural log of q and Fmort |
|
| 138 |
* parameters prior to evaluation. |
|
| 139 |
* |
|
| 140 |
*/ |
|
| 141 | 170x |
void Prepare() {
|
| 142 |
// for(size_t fleet_ = 0; fleet_ <= this->nfleets; fleet_++) {
|
|
| 143 |
// this -> Fmort[fleet_] = fims_math::exp(this -> log_Fmort[fleet_]); |
|
| 144 | ||
| 145 |
// derived quantities |
|
| 146 | 340x |
std::fill(catch_at_age.begin(), catch_at_age.end(), |
| 147 | 170x |
0); /**<derived quantity catch at age*/ |
| 148 | 340x |
std::fill(catch_index.begin(), catch_index.end(), |
| 149 | 170x |
0); /**<derived quantity catch index*/ |
| 150 | 340x |
std::fill(age_composition.begin(), age_composition.end(), |
| 151 | 170x |
0); /**<model expected number at age */ |
| 152 | 340x |
std::fill(length_composition.begin(), length_composition.end(), |
| 153 | 170x |
0); /**<model expected number at length */ |
| 154 | 340x |
std::fill(expected_catch.begin(), expected_catch.end(), |
| 155 | 170x |
0); /**<model expected total catch*/ |
| 156 | 340x |
std::fill(expected_index.begin(), expected_index.end(), |
| 157 | 170x |
0); /**<model expected index of abundance*/ |
| 158 | 340x |
std::fill(log_expected_index.begin(), log_expected_index.end(), |
| 159 | 170x |
0); /**<model expected index of abundance*/ |
| 160 | 340x |
std::fill(catch_numbers_at_age.begin(), catch_numbers_at_age.end(), |
| 161 | 170x |
0); /**<model expected catch at age*/ |
| 162 | 340x |
std::fill(proportion_catch_numbers_at_age.begin(), proportion_catch_numbers_at_age.end(), |
| 163 | 170x |
0); /**<model expected catch at age*/ |
| 164 | 340x |
std::fill(catch_numbers_at_length.begin(), catch_numbers_at_length.end(), |
| 165 | 170x |
0); /**<model expected catch at length*/ |
| 166 | 340x |
std::fill(proportion_catch_numbers_at_length.begin(), proportion_catch_numbers_at_length.end(), |
| 167 | 170x |
0); /**<model expected catch at length*/ |
| 168 | 340x |
std::fill(catch_weight_at_age.begin(), catch_weight_at_age.end(), |
| 169 | 170x |
0); /**<model expected weight at age*/ |
| 170 | ||
| 171 | 340x |
for (size_t i = 0; i < this->log_q.size(); i++) {
|
| 172 | 170x |
this->q[i] = fims_math::exp(this->log_q[i]); |
| 173 |
} |
|
| 174 | ||
| 175 | 5270x |
for (size_t year = 0; year < this->nyears; year++) {
|
| 176 | 5100x |
this->Fmort[year] = fims_math::exp(this->log_Fmort[year]); |
| 177 |
} |
|
| 178 |
} |
|
| 179 | ||
| 180 |
/** |
|
| 181 |
* Evaluate the proportion of catch numbers at age. |
|
| 182 |
*/ |
|
| 183 | ! |
void evaluate_age_comp() {
|
| 184 | ! |
for (size_t y = 0; y < this->nyears; y++) {
|
| 185 | ! |
Type sum = 0.0; |
| 186 | ! |
for (size_t a = 0; a < this->nages; a++) {
|
| 187 | ! |
size_t i_age_year = y * this->nages + a; |
| 188 | ! |
sum += this->catch_numbers_at_age[i_age_year]; |
| 189 |
} |
|
| 190 | ! |
for (size_t a = 0; a < this->nages; a++) {
|
| 191 | ! |
size_t i_age_year = y * this->nages + a; |
| 192 | ! |
this->proportion_catch_numbers_at_age[i_age_year] = this->catch_numbers_at_age[i_age_year] / sum; |
| 193 | ||
| 194 |
} |
|
| 195 |
} |
|
| 196 |
} |
|
| 197 | ||
| 198 |
/** |
|
| 199 |
* Evaluate the proportion of catch numbers at length. |
|
| 200 |
*/ |
|
| 201 | ! |
void evaluate_length_comp() {
|
| 202 | ! |
if (this->nlengths > 0) {
|
| 203 | ! |
for (size_t y = 0; y < this->nyears; y++) {
|
| 204 | ! |
Type sum = 0.0; |
| 205 | ! |
for (size_t l = 0; l < this->nlengths; l++) {
|
| 206 | ! |
size_t i_length_year = y * this->nlengths + l; |
| 207 | ! |
for(size_t a = 0; a < this->nages; a++) {
|
| 208 | ! |
size_t i_age_year = y * this->nages + a; |
| 209 | ! |
size_t i_length_age = a * this->nlengths + l; |
| 210 | ! |
this->catch_numbers_at_length[i_length_year] += |
| 211 | ! |
this->catch_numbers_at_age[i_age_year] * |
| 212 | ! |
this->age_length_conversion_matrix[i_length_age]; |
| 213 |
} |
|
| 214 | ! |
sum += this->catch_numbers_at_length[i_length_year]; |
| 215 |
} |
|
| 216 | ! |
for (size_t l = 0; l < this->nlengths; l++) {
|
| 217 | ! |
size_t i_length_year = y * this->nlengths + l; |
| 218 | ! |
this->proportion_catch_numbers_at_length[i_length_year] = |
| 219 | ! |
this->catch_numbers_at_length[i_length_year] / sum; |
| 220 |
} |
|
| 221 |
} |
|
| 222 |
} |
|
| 223 |
} |
|
| 224 | ||
| 225 |
/** |
|
| 226 |
* Evaluate the natural log of the expected index. |
|
| 227 |
*/ |
|
| 228 | ! |
void evaluate_index() {
|
| 229 | ! |
for (size_t i = 0; i<this->expected_index.size(); i++) {
|
| 230 | ! |
log_expected_index[i] = log(this->expected_index[i]); |
| 231 |
} |
|
| 232 |
} |
|
| 233 |
}; |
|
| 234 | ||
| 235 |
// default id of the singleton fleet class |
|
| 236 |
template <class Type> |
|
| 237 |
uint32_t Fleet<Type>::id_g = 0; |
|
| 238 | ||
| 239 |
} // end namespace fims_popdy |
|
| 240 | ||
| 241 |
#endif /* FIMS_POPULATION_DYNAMICS_FLEET_HPP */ |
| 1 |
/** |
|
| 2 |
* @file logistic.hpp |
|
| 3 |
* @brief Defines the LogisticMaturity class, which inherits from the |
|
| 4 |
* MaturityBase class. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
* |
|
| 9 |
*/ |
|
| 10 |
#ifndef POPULATION_DYNAMICS_MATURITY_LOGISTIC_HPP |
|
| 11 |
#define POPULATION_DYNAMICS_MATURITY_LOGISTIC_HPP |
|
| 12 | ||
| 13 |
#include "../../../common/fims_math.hpp" |
|
| 14 |
#include "../../../common/fims_vector.hpp" |
|
| 15 |
#include "maturity_base.hpp" |
|
| 16 | ||
| 17 |
namespace fims_popdy {
|
|
| 18 | ||
| 19 |
/** |
|
| 20 |
* @brief LogisticMaturity class that returns the logistic function value |
|
| 21 |
* from fims_math. |
|
| 22 |
*/ |
|
| 23 |
template <typename Type> |
|
| 24 |
struct LogisticMaturity : public MaturityBase<Type> {
|
|
| 25 |
fims::Vector<Type> inflection_point; /**< 50 percent quantile of the value of the quantity of |
|
| 26 |
interest (x); e.g. age at which 50 percent of the fish are mature */ |
|
| 27 |
fims::Vector<Type> slope; /**<scalar multiplier of difference between quantity of interest |
|
| 28 |
value (x) and inflection_point */ |
|
| 29 | ||
| 30 | 120x |
LogisticMaturity() : MaturityBase<Type>() |
| 31 |
{
|
|
| 32 |
} |
|
| 33 | ||
| 34 |
/** |
|
| 35 |
* @brief Method of the logistic maturity class that implements the |
|
| 36 |
* logistic function from FIMS math. |
|
| 37 |
* |
|
| 38 |
* \f[ \frac{1.0}{ 1.0 + exp(-1.0 * slope (x - inflection_point))} \f]
|
|
| 39 |
* |
|
| 40 |
* @param x The independent variable in the logistic function (e.g., age or |
|
| 41 |
* size at maturity). |
|
| 42 |
*/ |
|
| 43 | ||
| 44 | 4773x |
virtual const Type evaluate(const Type& x) |
| 45 |
{
|
|
| 46 | 4773x |
return fims_math::logistic<Type>(inflection_point[0], slope[0], x); |
| 47 |
} |
|
| 48 | ||
| 49 |
/** |
|
| 50 |
* @brief Method of the logistic maturity class that implements the |
|
| 51 |
* logistic function from FIMS math. |
|
| 52 |
* |
|
| 53 |
* \f[ \frac{1.0}{ 1.0 + exp(-1.0 * slope_t (x - {inflection\_point}_t))} \f]
|
|
| 54 |
* |
|
| 55 |
* @param x The independent variable in the logistic function (e.g., age or |
|
| 56 |
* size in selectivity). |
|
| 57 |
* @param pos Position index, e.g., which year. |
|
| 58 |
*/ |
|
| 59 | ! |
virtual const Type evaluate(const Type& x, size_t pos) |
| 60 |
{
|
|
| 61 | ! |
return fims_math::logistic<Type>(inflection_point.get_force_scalar(pos), slope.get_force_scalar(pos), x); |
| 62 |
} |
|
| 63 |
}; |
|
| 64 | ||
| 65 |
} // namespace fims_popdy |
|
| 66 | ||
| 67 |
#endif /* POPULATION_DYNAMICS_MATURITY_LOGISTIC_HPP */ |
| 1 |
/** |
|
| 2 |
* @file maturity_base.hpp |
|
| 3 |
* @brief Declares the MaturityBase class which is the base class for all |
|
| 4 |
* maturity functors. |
|
| 5 |
* @details Defines guards for maturity module outline to define the maturity |
|
| 6 |
* hpp file if not already defined. |
|
| 7 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 8 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 9 |
* folder for reuse information. |
|
| 10 |
*/ |
|
| 11 |
#ifndef POPULATION_DYNAMICS_MATURITY_BASE_HPP |
|
| 12 |
#define POPULATION_DYNAMICS_MATURITY_BASE_HPP |
|
| 13 | ||
| 14 |
#include "../../../common/model_object.hpp" |
|
| 15 | ||
| 16 |
namespace fims_popdy {
|
|
| 17 | ||
| 18 |
/** @brief Base class for all maturity functors. |
|
| 19 |
* |
|
| 20 |
* @tparam Type The type of the maturity functor. |
|
| 21 |
*/ |
|
| 22 | ||
| 23 |
template <typename Type> |
|
| 24 |
struct MaturityBase : public fims_model_object::FIMSObject<Type> {
|
|
| 25 |
// id_g is the ID of the instance of the MaturityBase class. |
|
| 26 |
// this is like a memory tracker. |
|
| 27 |
// Assigning each one its own ID is a way to keep track of |
|
| 28 |
// all the instances of the MaturityBase class. |
|
| 29 |
static uint32_t id_g; /**< The ID of the instance of the MaturityBase class */ |
|
| 30 | ||
| 31 |
/** @brief Constructor. |
|
| 32 |
*/ |
|
| 33 | 40x |
MaturityBase() |
| 34 |
{
|
|
| 35 |
// increment id of the singleton maturity class |
|
| 36 | 40x |
this->id = MaturityBase::id_g++; |
| 37 |
} |
|
| 38 | ||
| 39 |
/** |
|
| 40 |
* @brief Calculates the maturity. |
|
| 41 |
* @param x The independent variable in the maturity function (e.g., logistic |
|
| 42 |
* maturity at age or size). |
|
| 43 |
*/ |
|
| 44 |
virtual const Type evaluate(const Type& x) = 0; |
|
| 45 |
/** |
|
| 46 |
* @brief Calculates the selectivity. |
|
| 47 |
* @param x The independent variable in the logistic function (e.g., age or |
|
| 48 |
* size in selectivity). |
|
| 49 |
* @param pos Position index, e.g., which year. |
|
| 50 |
*/ |
|
| 51 |
virtual const Type evaluate(const Type& x, size_t pos) = 0; |
|
| 52 |
}; |
|
| 53 | ||
| 54 |
// default id of the singleton maturity class |
|
| 55 |
template <typename Type> |
|
| 56 |
uint32_t MaturityBase<Type>::id_g = 0; |
|
| 57 | ||
| 58 |
} // namespace fims_popdy |
|
| 59 | ||
| 60 |
#endif /* POPULATION_DYNAMICS_MATURITY_BASE_HPP */ |
| 1 |
/** |
|
| 2 |
* @file population.hpp |
|
| 3 |
* @brief Defines the Population class and its fields and methods. |
|
| 4 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 5 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 6 |
* folder for reuse information. |
|
| 7 |
*/ |
|
| 8 |
#ifndef FIMS_POPULATION_DYNAMICS_POPULATION_HPP |
|
| 9 |
#define FIMS_POPULATION_DYNAMICS_POPULATION_HPP |
|
| 10 | ||
| 11 |
#include "../../common/model_object.hpp" |
|
| 12 |
#include "../fleet/fleet.hpp" |
|
| 13 |
#include "../growth/growth.hpp" |
|
| 14 |
#include "../recruitment/recruitment.hpp" |
|
| 15 |
#include "../../interface/interface.hpp" |
|
| 16 |
#include "../maturity/maturity.hpp" |
|
| 17 | ||
| 18 |
namespace fims_popdy {
|
|
| 19 |
/*TODO: |
|
| 20 |
Review, add functions to evaluate, push vectors back to fleet (or point to |
|
| 21 |
fleet directly?) |
|
| 22 |
*/ |
|
| 23 | ||
| 24 |
/** |
|
| 25 |
* @brief Population class. Contains subpopulations |
|
| 26 |
* that are divided into generic partitions (eg. sex, area). |
|
| 27 |
*/ |
|
| 28 |
template <typename Type> |
|
| 29 |
struct Population : public fims_model_object::FIMSObject<Type> {
|
|
| 30 |
static uint32_t id_g; /*!< reference id for population object*/ |
|
| 31 |
size_t nyears; /*!< total number of years in the fishery*/ |
|
| 32 |
size_t nseasons; /*!< total number of seasons in the fishery*/ |
|
| 33 |
size_t nages; /*!< total number of ages in the population*/ |
|
| 34 |
size_t nfleets; /*!< total number of fleets in the fishery*/ |
|
| 35 | ||
| 36 |
// parameters are estimated; after initialize in create_model, push_back to |
|
| 37 |
// parameter list - in information.hpp (same for initial F in fleet) |
|
| 38 |
fims::Vector<Type> |
|
| 39 |
log_init_naa; /*!< estimated parameter: natural log of numbers at age*/ |
|
| 40 |
fims::Vector<Type> log_M; /*!< estimated parameter: natural log of Natural Mortality*/ |
|
| 41 | 49x |
fims::Vector<Type>proportion_female = fims::Vector<Type>(1, Type(0.5)); /*!< proportion female by age */ |
| 42 | ||
| 43 |
// Transformed values |
|
| 44 |
fims::Vector<Type> M; /*!< transformed parameter: natural mortality*/ |
|
| 45 | ||
| 46 |
fims::Vector<double> ages; /*!< vector of the ages for referencing*/ |
|
| 47 |
fims::Vector<double> years; /*!< vector of years for referencing*/ |
|
| 48 |
fims::Vector<Type> mortality_F; /*!< vector of fishing mortality summed across |
|
| 49 |
fleet by year and age*/ |
|
| 50 |
fims::Vector<Type> |
|
| 51 |
mortality_Z; /*!< vector of total mortality by year and age*/ |
|
| 52 | ||
| 53 |
// derived quantities |
|
| 54 |
fims::Vector<Type> |
|
| 55 |
weight_at_age; /*!< Derived quantity: expected weight at age */ |
|
| 56 |
// fecundity removed because we don't need it yet |
|
| 57 |
fims::Vector<Type> numbers_at_age; /*!< Derived quantity: population expected |
|
| 58 |
numbers at age in each year*/ |
|
| 59 |
fims::Vector<Type> |
|
| 60 |
unfished_numbers_at_age; /*!< Derived quantity: population expected |
|
| 61 |
unfished numbers at age in each year*/ |
|
| 62 |
fims::Vector<Type> |
|
| 63 |
biomass; /*!< Derived quantity: total population biomass in each year*/ |
|
| 64 |
fims::Vector<Type> spawning_biomass; /*!< Derived quantity: Spawning_biomass*/ |
|
| 65 |
fims::Vector<Type> unfished_biomass; /*!< Derived quanity |
|
| 66 |
biomass assuming unfished*/ |
|
| 67 |
fims::Vector<Type> unfished_spawning_biomass; /*!< Derived quanity Spawning |
|
| 68 |
biomass assuming unfished*/ |
|
| 69 |
fims::Vector<Type> proportion_mature_at_age; /*!< Derived quantity: Proportion |
|
| 70 |
mature at age */ |
|
| 71 |
fims::Vector<Type> expected_numbers_at_age; /*!< Expected values: Numbers at |
|
| 72 |
age (thousands?? millions??) */ |
|
| 73 |
fims::Vector<Type> expected_catch; /*!< Expected values: Catch*/ |
|
| 74 |
fims::Vector<Type> expected_recruitment; /*!< Expected recruitment */ |
|
| 75 |
/// recruitment |
|
| 76 | 49x |
int recruitment_id = -999; /*!< id of recruitment model object*/ |
| 77 |
std::shared_ptr<fims_popdy::RecruitmentBase<Type>> |
|
| 78 |
recruitment; /*!< shared pointer to recruitment module */ |
|
| 79 | ||
| 80 |
// growth |
|
| 81 | 49x |
int growth_id = -999; /*!< id of growth model object*/ |
| 82 |
std::shared_ptr<fims_popdy::GrowthBase<Type>> |
|
| 83 |
growth; /*!< shared pointer to growth module */ |
|
| 84 | ||
| 85 |
// maturity |
|
| 86 | 49x |
int maturity_id = -999; /*!< id of maturity model object*/ |
| 87 |
std::shared_ptr<fims_popdy::MaturityBase<Type>> |
|
| 88 |
maturity; /*!< shared pointer to maturity module */ |
|
| 89 | ||
| 90 |
// fleet |
|
| 91 | 49x |
int fleet_id = -999; /*!< id of fleet model object*/ |
| 92 |
std::vector<std::shared_ptr<fims_popdy::Fleet<Type>>> |
|
| 93 |
fleets; /*!< shared pointer to fleet module */ |
|
| 94 | ||
| 95 |
// Define objective function object to be able to REPORT and ADREPORT |
|
| 96 | ||
| 97 |
#ifdef TMB_MODEL |
|
| 98 |
::objective_function<Type> |
|
| 99 |
*of; // :: references global namespace, defined in src/FIMS.cpp, |
|
| 100 |
// available anywhere in the R package |
|
| 101 |
#endif |
|
| 102 | ||
| 103 |
// this -> means you're referring to a class member (member of self) |
|
| 104 | ||
| 105 | 147x |
Population() {
|
| 106 | 49x |
this->id = Population::id_g++; |
| 107 |
} |
|
| 108 | ||
| 109 |
/** |
|
| 110 |
* @brief Initialize values. Called once at the start of model run. |
|
| 111 |
* |
|
| 112 |
* @param nyears number of years in the population |
|
| 113 |
* @param nseasons number of seasons in the population |
|
| 114 |
* @param nages number of ages in the population |
|
| 115 |
*/ |
|
| 116 | 46x |
void Initialize(int nyears, int nseasons, int nages) {
|
| 117 | 46x |
this->nyears = nyears; |
| 118 | 46x |
this->nseasons = nseasons; |
| 119 | 46x |
this->nages = nages; |
| 120 | ||
| 121 |
// size all the vectors to length of nages |
|
| 122 | 46x |
nfleets = fleets.size(); |
| 123 | 46x |
expected_catch.resize(nyears * nfleets); |
| 124 | 46x |
years.resize(nyears); |
| 125 | 46x |
mortality_F.resize(nyears * nages); |
| 126 | 46x |
mortality_Z.resize(nyears * nages); |
| 127 | 46x |
proportion_mature_at_age.resize((nyears + 1) * nages); |
| 128 | 46x |
proportion_female.resize(nages); |
| 129 | 46x |
weight_at_age.resize(nages); |
| 130 | 46x |
unfished_numbers_at_age.resize((nyears + 1) * nages); |
| 131 | 46x |
biomass.resize((nyears + 1)); |
| 132 | 46x |
unfished_biomass.resize((nyears + 1)); |
| 133 | 46x |
unfished_spawning_biomass.resize((nyears + 1)); |
| 134 | 46x |
spawning_biomass.resize((nyears + 1)); |
| 135 | 46x |
expected_recruitment.resize((nyears + 1)); |
| 136 | 46x |
M.resize(nyears * nages); |
| 137 | 46x |
ages.resize(nages); |
| 138 | 46x |
log_init_naa.resize(nages); |
| 139 | 46x |
log_M.resize(nyears * nages); |
| 140 |
} |
|
| 141 | ||
| 142 |
/** |
|
| 143 |
* @brief Prepare to run the population loop. Called at each model iteration, |
|
| 144 |
* and used to zero out derived quantities, values that were summed, etc. |
|
| 145 |
* |
|
| 146 |
*/ |
|
| 147 | 43x |
void Prepare() {
|
| 148 | ||
| 149 | 129x |
for (size_t fleet = 0; fleet < this->fleets.size(); fleet++) {
|
| 150 | 86x |
this->fleets[fleet]->Prepare(); |
| 151 |
} |
|
| 152 | ||
| 153 | 43x |
std::fill(biomass.begin(), biomass.end(), 0.0); |
| 154 | 86x |
std::fill(unfished_spawning_biomass.begin(), |
| 155 | 43x |
unfished_spawning_biomass.end(), 0.0); |
| 156 | 43x |
std::fill(spawning_biomass.begin(), spawning_biomass.end(), 0.0); |
| 157 | 43x |
std::fill(expected_catch.begin(), expected_catch.end(), 0.0); |
| 158 | 43x |
std::fill(expected_recruitment.begin(), expected_recruitment.end(), 0.0); |
| 159 | 86x |
std::fill(proportion_mature_at_age.begin(), proportion_mature_at_age.end(), |
| 160 | 43x |
0.0); |
| 161 | 43x |
std::fill(mortality_Z.begin(), mortality_Z.end(), 0.0); |
| 162 | 43x |
std::fill(proportion_female.begin(), proportion_female.end(), 0.5); |
| 163 | ||
| 164 |
// Transformation Section |
|
| 165 | 559x |
for (size_t age = 0; age < this->nages; age++) {
|
| 166 | 516x |
this->weight_at_age[age] = growth->evaluate(ages[age]); |
| 167 | 15996x |
for (size_t year = 0; year < this->nyears; year++) {
|
| 168 | 15480x |
size_t i_age_year = age * this->nyears + year; |
| 169 | 15480x |
this->M[i_age_year] = fims_math::exp(this->log_M[i_age_year]); |
| 170 |
// mortality_F is a fims::Vector and therefore needs to be filled |
|
| 171 |
// within a loop |
|
| 172 | 15480x |
this->mortality_F[i_age_year] = 0.0; |
| 173 |
} |
|
| 174 |
} |
|
| 175 |
} |
|
| 176 | ||
| 177 |
/** |
|
| 178 |
* life history calculations |
|
| 179 |
*/ |
|
| 180 | ||
| 181 |
/** |
|
| 182 |
* @brief Calculates initial numbers at age for index and age |
|
| 183 |
* |
|
| 184 |
* @param i_age_year dimension folded index for age and year |
|
| 185 |
* @param a age index |
|
| 186 |
*/ |
|
| 187 | 1128x |
inline void CalculateInitialNumbersAA( |
| 188 |
size_t i_age_year, size_t a) { // inline all function unless complicated
|
|
| 189 | 1128x |
this->numbers_at_age[i_age_year] = fims_math::exp(this->log_init_naa[a]); |
| 190 |
} |
|
| 191 | ||
| 192 |
/** |
|
| 193 |
* @brief Calculates total mortality at an index, year, and age |
|
| 194 |
* |
|
| 195 |
* @param i_age_year dimension folded index for age and year |
|
| 196 |
* @param year year index |
|
| 197 |
* @param age age index |
|
| 198 |
*/ |
|
| 199 | 2562x |
void CalculateMortality(size_t i_age_year, size_t year, size_t age) {
|
| 200 | 7686x |
for (size_t fleet_ = 0; fleet_ < this->nfleets; fleet_++) {
|
| 201 | 5124x |
if (this->fleets[fleet_]->is_survey == false) {
|
| 202 | 2562x |
this->mortality_F[i_age_year] += |
| 203 | 2562x |
this->fleets[fleet_]->Fmort[year] * |
| 204 |
// evaluate is a member function of the selectivity class |
|
| 205 | 2562x |
this->fleets[fleet_]->selectivity->evaluate(ages[age]); |
| 206 | ||
| 207 |
} |
|
| 208 |
} |
|
| 209 | ||
| 210 | 2562x |
this->mortality_Z[i_age_year] = |
| 211 | 2562x |
this->M[i_age_year] + this->mortality_F[i_age_year]; |
| 212 |
} |
|
| 213 | ||
| 214 |
/** |
|
| 215 |
* @brief Calculates numbers at age at year and age specific indices |
|
| 216 |
* |
|
| 217 |
* @param i_age_year dimension folded index for age and year |
|
| 218 |
* @param i_agem1_yearm1 dimension folded index for age-1 and year-1 |
|
| 219 |
* @param age age index |
|
| 220 |
*/ |
|
| 221 | 1362x |
inline void CalculateNumbersAA(size_t i_age_year, size_t i_agem1_yearm1, |
| 222 |
size_t age) {
|
|
| 223 |
// using Z from previous age/year |
|
| 224 | 1362x |
this->numbers_at_age[i_age_year] = |
| 225 | 2724x |
this->numbers_at_age[i_agem1_yearm1] * |
| 226 | 1362x |
(fims_math::exp(-this->mortality_Z[i_agem1_yearm1])); |
| 227 | ||
| 228 |
// Plus group calculation |
|
| 229 | 1362x |
if (age == (this->nages - 1)) {
|
| 230 | 123x |
this->numbers_at_age[i_age_year] = |
| 231 | 246x |
this->numbers_at_age[i_age_year] + |
| 232 | 123x |
this->numbers_at_age[i_agem1_yearm1 + 1] * |
| 233 | 123x |
(fims_math::exp(-this->mortality_Z[i_agem1_yearm1 + 1])); |
| 234 |
} |
|
| 235 |
} |
|
| 236 | ||
| 237 |
/** |
|
| 238 |
* @brief Calculates unfished numbers at age at year and age specific indices |
|
| 239 |
* |
|
| 240 |
* @param i_age_year dimension folded index for age and year |
|
| 241 |
* @param i_agem1_yearm1 dimension folded index for age-1 and year-1 |
|
| 242 |
* @param age age index |
|
| 243 |
*/ |
|
| 244 | 2387x |
inline void CalculateUnfishedNumbersAA(size_t i_age_year, |
| 245 |
size_t i_agem1_yearm1, size_t age) {
|
|
| 246 |
// using M from previous age/year |
|
| 247 | 2387x |
this->unfished_numbers_at_age[i_age_year] = |
| 248 | 4774x |
this->unfished_numbers_at_age[i_agem1_yearm1] * |
| 249 | ||
| 250 | 2387x |
(fims_math::exp(-this->M[i_agem1_yearm1])); |
| 251 | ||
| 252 |
// Plus group calculation |
|
| 253 | 2387x |
if (age == (this->nages - 1)) {
|
| 254 | 217x |
this->unfished_numbers_at_age[i_age_year] = |
| 255 | 434x |
this->unfished_numbers_at_age[i_age_year] + |
| 256 | 217x |
this->unfished_numbers_at_age[i_agem1_yearm1 + 1] * |
| 257 | 217x |
(fims_math::exp(-this->M[i_agem1_yearm1 + 1])); |
| 258 |
} |
|
| 259 |
} |
|
| 260 | ||
| 261 |
/** |
|
| 262 |
* @brief Calculates biomass |
|
| 263 |
* |
|
| 264 |
* @param i_age_year dimension folded index for age and year |
|
| 265 |
* @param year the year biomass is being aggregated for |
|
| 266 |
* @param age the age who's biomass is being added into total biomass |
|
| 267 |
*/ |
|
| 268 | 1491x |
void CalculateBiomass(size_t i_age_year, size_t year, size_t age) {
|
| 269 | 1491x |
this->biomass[year] += |
| 270 | 1491x |
this->numbers_at_age[i_age_year] * this->weight_at_age[age]; |
| 271 |
} |
|
| 272 | ||
| 273 |
/** |
|
| 274 |
* @brief Adds to existing yearly unfished biomass estimates the |
|
| 275 |
* biomass for a specified year and age |
|
| 276 |
* |
|
| 277 |
* @param i_age_year dimension folded index for age and year |
|
| 278 |
* @param year the year of unfished biomass to add |
|
| 279 |
* @param age the age of unfished biomass to add |
|
| 280 |
*/ |
|
| 281 | 1488x |
void CalculateUnfishedBiomass(size_t i_age_year, size_t year, size_t age) {
|
| 282 | 1488x |
this->unfished_biomass[year] += |
| 283 | 1488x |
this->unfished_numbers_at_age[i_age_year] * this->weight_at_age[age]; |
| 284 |
} |
|
| 285 | ||
| 286 |
/** |
|
| 287 |
* @brief Calculates spawning biomass |
|
| 288 |
* |
|
| 289 |
* @param i_age_year dimension folded index for age and year |
|
| 290 |
* @param year the year spawning biomass is being aggregated for |
|
| 291 |
* @param age the age who's biomass is being added into total spawning biomass |
|
| 292 |
*/ |
|
| 293 | 1497x |
void CalculateSpawningBiomass(size_t i_age_year, size_t year, size_t age) {
|
| 294 | 1497x |
this->spawning_biomass[year] += |
| 295 | 2994x |
this->proportion_female[age] * this->numbers_at_age[i_age_year] * |
| 296 | 2994x |
this->proportion_mature_at_age[i_age_year] * this->weight_at_age[age]; |
| 297 |
} |
|
| 298 | ||
| 299 |
/** |
|
| 300 |
* @brief Adds to existing yearly unfished spawning biomass estimates the |
|
| 301 |
* biomass for a specified year and age |
|
| 302 |
* |
|
| 303 |
* @param i_age_year dimension folded index for age and year |
|
| 304 |
* @param year the year of unfished spawning biomass to add |
|
| 305 |
* @param age the age of unfished spawning biomass to add |
|
| 306 |
*/ |
|
| 307 | 2604x |
void CalculateUnfishedSpawningBiomass(size_t i_age_year, size_t year, |
| 308 |
size_t age) {
|
|
| 309 | 2604x |
this->unfished_spawning_biomass[year] += |
| 310 | 5208x |
this->proportion_female[age] * |
| 311 | 5208x |
this->unfished_numbers_at_age[i_age_year] * |
| 312 | 5208x |
this->proportion_mature_at_age[i_age_year] * this->weight_at_age[age]; |
| 313 |
} |
|
| 314 | ||
| 315 |
/** |
|
| 316 |
* @brief Calculates equilibrium spawning biomass per recruit |
|
| 317 |
* |
|
| 318 |
* @return Type |
|
| 319 |
*/ |
|
| 320 | 126x |
Type CalculateSBPR0() {
|
| 321 | 126x |
std::vector<Type> numbers_spr(this->nages, 1.0); |
| 322 | 126x |
Type phi_0 = 0.0; |
| 323 | 252x |
phi_0 += numbers_spr[0] * this->proportion_female[0] * |
| 324 | 126x |
this->proportion_mature_at_age[0] * |
| 325 | 126x |
this->growth->evaluate(ages[0]); |
| 326 | 1386x |
for (size_t a = 1; a < (this->nages - 1); a++) {
|
| 327 | 1260x |
numbers_spr[a] = numbers_spr[a - 1] * fims_math::exp(-this->M[a]); |
| 328 | 2520x |
phi_0 += numbers_spr[a] * this->proportion_female[a] * |
| 329 | 1260x |
this->proportion_mature_at_age[a] * |
| 330 | 1260x |
this->growth->evaluate(ages[a]); |
| 331 |
} |
|
| 332 | ||
| 333 | 126x |
numbers_spr[this->nages - 1] = |
| 334 | 252x |
(numbers_spr[nages - 2] * fims_math::exp(-this->M[nages - 2])) / |
| 335 | 126x |
(1 - fims_math::exp(-this->M[this->nages - 1])); |
| 336 | 252x |
phi_0 += numbers_spr[this->nages - 1] * |
| 337 | 132x |
this->proportion_female[this->nages - 1] * |
| 338 | 126x |
this->proportion_mature_at_age[this->nages - 1] * |
| 339 | 126x |
this->growth->evaluate(ages[this->nages - 1]); |
| 340 | 126x |
return phi_0; |
| 341 |
} |
|
| 342 | ||
| 343 |
/** |
|
| 344 |
* @brief Calculates expected recruitment for a given year |
|
| 345 |
* |
|
| 346 |
* @param i_age_year dimension folded index for age and year |
|
| 347 |
* @param year the year recruitment is being calculated for |
|
| 348 |
* @param i_dev index to log_recruit_dev of vector length nyears-1 |
|
| 349 |
*/ |
|
| 350 | 123x |
void CalculateRecruitment(size_t i_age_year, size_t year, size_t i_dev) {
|
| 351 | 123x |
Type phi0 = CalculateSBPR0(); |
| 352 | ||
| 353 | 123x |
if (i_dev == this->nyears) {
|
| 354 | 4x |
this->numbers_at_age[i_age_year] = |
| 355 | 4x |
this->recruitment->evaluate(this->spawning_biomass[year - 1], phi0); |
| 356 |
/*the final year of the time series has no data to inform recruitment |
|
| 357 |
devs, so this value is set to the mean recruitment.*/ |
|
| 358 |
} else {
|
|
| 359 | 119x |
this->numbers_at_age[i_age_year] = |
| 360 | 238x |
this->recruitment->evaluate(this->spawning_biomass[year - 1], phi0) * |
| 361 |
/*the log_recruit_dev vector does not include a value for year == 0 |
|
| 362 |
and is of length nyears - 1 where the first position of the vector |
|
| 363 |
corresponds to the second year of the time series.*/ |
|
| 364 | 119x |
fims_math::exp(this->recruitment->log_recruit_devs[i_dev - 1]); |
| 365 | 119x |
this->expected_recruitment[year] = this->numbers_at_age[i_age_year]; |
| 366 |
} |
|
| 367 | ||
| 368 |
} |
|
| 369 | ||
| 370 |
/** |
|
| 371 |
* @brief Adds to exiting expected total catch by fleet in weight |
|
| 372 |
* |
|
| 373 |
* @param year the year of expected total catch |
|
| 374 |
* @param age the age of catch that is being added into total catch |
|
| 375 |
*/ |
|
| 376 | 1443x |
void CalculateCatch(size_t year, size_t age) {
|
| 377 | 4329x |
for (size_t fleet_ = 0; fleet_ < this->nfleets; fleet_++) {
|
| 378 | 2886x |
if (this->fleets[fleet_]->is_survey == false) {
|
| 379 | 2886x |
size_t index_yf = year * this->nfleets + |
| 380 | 1443x |
fleet_; // index by fleet and years to dimension fold |
| 381 | 1443x |
size_t i_age_year = year * this->nages + age; |
| 382 | ||
| 383 | 1443x |
this->expected_catch[index_yf] += |
| 384 | 1443x |
this->fleets[fleet_]->catch_weight_at_age[i_age_year]; |
| 385 | ||
| 386 | 1443x |
fleets[fleet_]->expected_catch[year] += |
| 387 | 1443x |
this->fleets[fleet_]->catch_weight_at_age[i_age_year]; |
| 388 |
} |
|
| 389 |
} |
|
| 390 |
} |
|
| 391 | ||
| 392 |
/** |
|
| 393 |
* @brief Adds to the expected population indices by fleet |
|
| 394 |
* |
|
| 395 |
* @param i_age_year dimension folded index for age and year |
|
| 396 |
* @param year the year of the population index |
|
| 397 |
* @param age the age of the index that is added into population index |
|
| 398 |
*/ |
|
| 399 | 1443x |
void CalculateIndex(size_t i_age_year, size_t year, size_t age) {
|
| 400 | 4329x |
for (size_t fleet_ = 0; fleet_ < this->nfleets; fleet_++) {
|
| 401 | ! |
Type index_; |
| 402 |
// I = qN (N is total numbers), I is an index in numbers |
|
| 403 | 2886x |
if (this->fleets[fleet_]->is_survey == false) {
|
| 404 | 2886x |
index_ = this->fleets[fleet_]->catch_numbers_at_age[i_age_year] * |
| 405 | 1443x |
this->weight_at_age[age]; |
| 406 |
} else {
|
|
| 407 | 4329x |
index_ = this->fleets[fleet_]->q.get_force_scalar(year) * |
| 408 | 2886x |
this->fleets[fleet_]->selectivity->evaluate(ages[age]) * |
| 409 | 2886x |
this->numbers_at_age[i_age_year] * |
| 410 | 1443x |
this->weight_at_age[age]; // this->weight_at_age[age]; |
| 411 |
} |
|
| 412 | 2886x |
fleets[fleet_]->expected_index[year] += index_; |
| 413 |
} |
|
| 414 |
} |
|
| 415 | ||
| 416 |
/** |
|
| 417 |
* @brief Calculates catch in numbers at age for each fleet for a given year |
|
| 418 |
* and age, then adds the value to the expected catch in numbers at age for |
|
| 419 |
* each fleet |
|
| 420 |
* |
|
| 421 |
* @param i_age_year dimension folded index for age and year |
|
| 422 |
* @param year the year of expected catch composition is being calculated for |
|
| 423 |
* @param age the age composition is being calculated for |
|
| 424 |
*/ |
|
| 425 | 1446x |
void CalculateCatchNumbersAA(size_t i_age_year, size_t year, size_t age) {
|
| 426 | 4338x |
for (size_t fleet_ = 0; fleet_ < this->nfleets; fleet_++) {
|
| 427 |
// make an intermediate value in order to set multiple members (of |
|
| 428 |
// current and fleet objects) to that value. |
|
| 429 | ! |
Type catch_; // catch_ is used to avoid using the c++ keyword catch |
| 430 |
// Baranov Catch Equation |
|
| 431 | 2892x |
if (this->fleets[fleet_]->is_survey == false) {
|
| 432 | 4338x |
catch_ = (this->fleets[fleet_]->Fmort[year] * |
| 433 | 2892x |
this->fleets[fleet_]->selectivity->evaluate(ages[age])) / |
| 434 | 2892x |
this->mortality_Z[i_age_year] * |
| 435 | 2892x |
this->numbers_at_age[i_age_year] * |
| 436 | 1446x |
(1 - fims_math::exp(-(this->mortality_Z[i_age_year]))); |
| 437 |
} else {
|
|
| 438 | 2892x |
catch_ = (this->fleets[fleet_]->selectivity->evaluate(ages[age])) * |
| 439 | 1446x |
this->numbers_at_age[i_age_year]; |
| 440 |
} |
|
| 441 | ||
| 442 |
// this->catch_numbers_at_age[i_age_yearf] += catch_; |
|
| 443 |
// catch_numbers_at_age for the fleet module has different |
|
| 444 |
// dimensions (year/age, not year/fleet/age) |
|
| 445 | 2892x |
this->fleets[fleet_]->catch_numbers_at_age[i_age_year] += catch_; |
| 446 |
} |
|
| 447 |
} |
|
| 448 | ||
| 449 |
/** |
|
| 450 |
* @brief Calculates expected catch weight at age for each fleet for a given |
|
| 451 |
* year and age |
|
| 452 |
* |
|
| 453 |
* @param year the year of expected catch weight at age |
|
| 454 |
* @param age the age of expected catch weight at age |
|
| 455 |
*/ |
|
| 456 | 1446x |
void CalculateCatchWeightAA(size_t year, size_t age) {
|
| 457 | 1446x |
int i_age_year = year * this->nages + age; |
| 458 | 4338x |
for (size_t fleet_ = 0; fleet_ < this->nfleets; fleet_++) {
|
| 459 | ||
| 460 | 2892x |
this->fleets[fleet_]->catch_weight_at_age[i_age_year] = |
| 461 | 5784x |
this->fleets[fleet_]->catch_numbers_at_age[i_age_year] * |
| 462 | 2892x |
this->weight_at_age[age]; |
| 463 | ||
| 464 |
} |
|
| 465 |
} |
|
| 466 | ||
| 467 |
/** |
|
| 468 |
* @brief Calculates expected proportion of individuals mature at a selected |
|
| 469 |
* ageage |
|
| 470 |
* |
|
| 471 |
* @param i_age_year dimension folded index for age and year |
|
| 472 |
* @param age the age of maturity |
|
| 473 |
*/ |
|
| 474 | 4770x |
void CalculateMaturityAA(size_t i_age_year, size_t age) {
|
| 475 |
// this->maturity is pointing to the maturity module, which has |
|
| 476 |
// an evaluate function. -> can be nested. |
|
| 477 | ||
| 478 | 4770x |
this->proportion_mature_at_age[i_age_year] = |
| 479 | 4770x |
this->maturity->evaluate(ages[age]); |
| 480 | ||
| 481 |
} |
|
| 482 | ||
| 483 |
/** |
|
| 484 |
* @brief Executes the population loop |
|
| 485 |
* |
|
| 486 |
*/ |
|
| 487 | 4x |
void Evaluate() {
|
| 488 |
/* |
|
| 489 |
Sets derived vectors to zero |
|
| 490 |
Performs parameters transformations |
|
| 491 |
Sets recruitment deviations to mean 0. |
|
| 492 |
*/ |
|
| 493 | 4x |
Prepare(); |
| 494 |
/* |
|
| 495 |
start at year=0, age=0; |
|
| 496 |
here year 0 is the estimated initial population structure and age 0 are recruits |
|
| 497 |
loops start at zero with if statements inside to specify unique code for |
|
| 498 |
initial structure and recruitment 0 loops. Could also have started loops at |
|
| 499 |
1 with initial structure and recruitment setup outside the loops. |
|
| 500 | ||
| 501 |
year loop is extended to <= nyears because SSB is calculted as the start of |
|
| 502 |
the year value and by extending one extra year we get estimates of the |
|
| 503 |
population structure at the end of the final year. An alternative approach |
|
| 504 |
would be to keep initial numbers at age in it's own vector and each year to |
|
| 505 |
include the population structure at the end of the year. This is likely a |
|
| 506 |
null point given that we are planning to modify to an event/stanza based |
|
| 507 |
structure in later milestones which will elimitate this confusion by |
|
| 508 |
explicity referencing the exact date (or period of averaging) at which any |
|
| 509 |
calculation or output is being made. |
|
| 510 |
*/ |
|
| 511 | 128x |
for (size_t y = 0; y <= this->nyears; y++) {
|
| 512 | 1612x |
for (size_t a = 0; a < this->nages; a++) {
|
| 513 |
/* |
|
| 514 |
index naming defines the dimensional folding structure |
|
| 515 |
i.e. i_age_year is referencing folding over years and ages. |
|
| 516 |
*/ |
|
| 517 | 1488x |
size_t i_age_year = y * this->nages + a; |
| 518 |
/* |
|
| 519 |
Mortality rates are not estimated in the final year which is |
|
| 520 |
used to show expected population structure at the end of the model period. |
|
| 521 |
This is because biomass in year i represents biomass at the start of |
|
| 522 |
the year. |
|
| 523 |
Should we add complexity to track more values such as start, |
|
| 524 |
mid, and end biomass in all years where, start biomass=end biomass of |
|
| 525 |
the previous year? Referenced above, this is probably not worth |
|
| 526 |
exploring as later milestone changes will eliminate this confusion. |
|
| 527 |
*/ |
|
| 528 | 1488x |
if (y < this->nyears) {
|
| 529 |
/* |
|
| 530 |
First thing we need is total mortality aggregated across all fleets |
|
| 531 |
to inform the subsequent catch and change in numbers at age |
|
| 532 |
calculations. This is only calculated for years < nyears as these are |
|
| 533 |
the model estimated years with data. The year loop extends to |
|
| 534 |
y=nyears so that population numbers at age and SSB can be calculated |
|
| 535 |
at the end of the last year of the model |
|
| 536 |
*/ |
|
| 537 | 1440x |
CalculateMortality(i_age_year, y, a); |
| 538 |
} |
|
| 539 | 1488x |
CalculateMaturityAA(i_age_year, a); |
| 540 |
/* if statements needed because some quantities are only needed |
|
| 541 |
for the first year and/or age, so these steps are included here. |
|
| 542 |
*/ |
|
| 543 | 1488x |
if (y == 0) {
|
| 544 |
// Initial numbers at age is a user input or estimated parameter |
|
| 545 |
// vector. |
|
| 546 | 48x |
CalculateInitialNumbersAA(i_age_year, a); |
| 547 | ||
| 548 | 48x |
if (a == 0) {
|
| 549 | 4x |
this->unfished_numbers_at_age[i_age_year] = |
| 550 | 4x |
fims_math::exp(this->recruitment->log_rzero[0]); |
| 551 |
} else {
|
|
| 552 | 44x |
CalculateUnfishedNumbersAA(i_age_year, a - 1, a); |
| 553 |
} |
|
| 554 | ||
| 555 |
/* |
|
| 556 |
Fished and unfished biomass vectors are summing biomass at |
|
| 557 |
age across ages. |
|
| 558 |
*/ |
|
| 559 | ||
| 560 | 48x |
CalculateBiomass(i_age_year, y, a); |
| 561 | ||
| 562 | 48x |
CalculateUnfishedBiomass(i_age_year, y, a); |
| 563 | ||
| 564 |
/* |
|
| 565 |
Fished and unfished spawning biomass vectors are summing biomass at |
|
| 566 |
age across ages to allow calculation of recruitment in the next year. |
|
| 567 |
*/ |
|
| 568 | ||
| 569 | 48x |
CalculateSpawningBiomass(i_age_year, y, a); |
| 570 | ||
| 571 | 48x |
CalculateUnfishedSpawningBiomass(i_age_year, y, a); |
| 572 | ||
| 573 |
/* |
|
| 574 |
Expected recruitment in year 0 is numbers at age 0 in year 0. |
|
| 575 |
*/ |
|
| 576 | ||
| 577 | 48x |
this->expected_recruitment[i_age_year] = |
| 578 | 48x |
this->numbers_at_age[i_age_year]; |
| 579 | ||
| 580 |
} else {
|
|
| 581 | 1440x |
if (a == 0) {
|
| 582 |
// Set the nrecruits for age a=0 year y (use pointers instead of |
|
| 583 |
// functional returns) assuming fecundity = 1 and 50:50 sex ratio |
|
| 584 | 120x |
CalculateRecruitment(i_age_year, y, y); |
| 585 | 120x |
this->unfished_numbers_at_age[i_age_year] = |
| 586 | 120x |
fims_math::exp(this->recruitment->log_rzero[0]); |
| 587 | ||
| 588 |
} else {
|
|
| 589 | 1320x |
size_t i_agem1_yearm1 = (y - 1) * nages + (a - 1); |
| 590 | 1320x |
CalculateNumbersAA(i_age_year, i_agem1_yearm1, a); |
| 591 | 1320x |
CalculateUnfishedNumbersAA(i_age_year, i_agem1_yearm1, a); |
| 592 |
} |
|
| 593 | 1440x |
CalculateBiomass(i_age_year, y, a); |
| 594 | 1440x |
CalculateSpawningBiomass(i_age_year, y, a); |
| 595 | ||
| 596 | 1440x |
CalculateUnfishedBiomass(i_age_year, y, a); |
| 597 | 1440x |
CalculateUnfishedSpawningBiomass(i_age_year, y, a); |
| 598 |
} |
|
| 599 | ||
| 600 |
/* |
|
| 601 |
Here composition, total catch, and index values are calculated for all |
|
| 602 |
years with reference data. They are not calculated for y=nyears as there |
|
| 603 |
is this is just to get final population structure at the end of the |
|
| 604 |
terminal year. |
|
| 605 |
*/ |
|
| 606 | 1488x |
if (y < this->nyears) {
|
| 607 | 1440x |
CalculateCatchNumbersAA(i_age_year, y, a); |
| 608 | ||
| 609 | 1440x |
CalculateCatchWeightAA(y, a); |
| 610 | 1440x |
CalculateCatch(y, a); |
| 611 | 1440x |
CalculateIndex(i_age_year, y, a); |
| 612 |
} |
|
| 613 |
} |
|
| 614 |
} |
|
| 615 | ||
| 616 |
} |
|
| 617 |
}; |
|
| 618 |
template <class Type> |
|
| 619 |
uint32_t Population<Type>::id_g = 0; |
|
| 620 | ||
| 621 |
} // namespace fims_popdy |
|
| 622 | ||
| 623 |
#endif /* FIMS_POPULATION_DYNAMICS_POPULATION_HPP */ |
| 1 |
/** |
|
| 2 |
* @file recruitment_base.hpp |
|
| 3 |
* @brief Serves as the parent class where recruitment functions are called. |
|
| 4 |
* @details Defines guards for recruitment base outline to define the |
|
| 5 |
* recruitment hpp file if not already defined. |
|
| 6 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 7 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 8 |
* folder for reuse information. |
|
| 9 |
*/ |
|
| 10 |
#ifndef FIMS_POPULATION_DYNAMICS_RECRUITMENT_BASE_HPP |
|
| 11 |
#define FIMS_POPULATION_DYNAMICS_RECRUITMENT_BASE_HPP |
|
| 12 | ||
| 13 |
#include <cmath> // for using std::pow and M_PI |
|
| 14 | ||
| 15 |
#include "../../../common/fims_math.hpp" // for using fims_math::log() |
|
| 16 |
#include "../../../common/fims_vector.hpp" |
|
| 17 |
#include "../../../common/model_object.hpp" |
|
| 18 |
#include "../../../distributions/distributions.hpp" |
|
| 19 | ||
| 20 |
namespace fims_popdy {
|
|
| 21 | ||
| 22 |
/** @brief Base class for all recruitment functors. |
|
| 23 |
* |
|
| 24 |
* @tparam Type The type of the recruitment functor. |
|
| 25 |
* |
|
| 26 |
*/ |
|
| 27 |
template <class Type> |
|
| 28 |
struct RecruitmentBase : public fims_model_object::FIMSObject<Type> {
|
|
| 29 |
static uint32_t id_g; /**< reference id for recruitment object*/ |
|
| 30 | ||
| 31 |
fims::Vector<Type> |
|
| 32 |
log_recruit_devs; /*!< A vector of the natural log of recruitment deviations */ |
|
| 33 | 46x |
bool constrain_deviations = false; /*!< A flag to indicate if recruitment |
| 34 |
deviations are summing to zero or not */ |
|
| 35 | ||
| 36 |
fims::Vector<Type> log_rzero; /**< Natural log of unexploited recruitment.*/ |
|
| 37 | ||
| 38 | 46x |
bool estimate_log_recruit_devs = true; /*!< A flag to indicate if recruitment |
| 39 |
deviations are estimated or not */ |
|
| 40 | ||
| 41 |
/** @brief Constructor. |
|
| 42 |
*/ |
|
| 43 | 46x |
RecruitmentBase() { this->id = RecruitmentBase::id_g++; }
|
| 44 | ||
| 45 | 46x |
virtual ~RecruitmentBase() {}
|
| 46 | ||
| 47 |
/** |
|
| 48 |
* @brief Prepares the recruitment deviations vector. |
|
| 49 |
* |
|
| 50 |
*/ |
|
| 51 | ! |
void Prepare() { this->PrepareConstrainedDeviations(); }
|
| 52 | ||
| 53 |
/** @brief Calculates the expected recruitment for a given spawning input. |
|
| 54 |
* |
|
| 55 |
* @param spawners A measure for spawning output. |
|
| 56 |
* @param ssbzero A measure for spawning output in unfished population. |
|
| 57 |
* |
|
| 58 |
*/ |
|
| 59 |
virtual const Type evaluate( |
|
| 60 |
const Type &spawners, |
|
| 61 |
const Type &ssbzero) = 0; // need to add input parameter values |
|
| 62 | ||
| 63 | ||
| 64 |
/** @brief Prepare constrained recruitment deviations. |
|
| 65 |
* Based on ADMB sum-to-zero constraint implementation. We still |
|
| 66 |
* need to adde an additional penalty to the PrepareConstrainedDeviations |
|
| 67 |
* method. More discussion can be found here: |
|
| 68 |
* https://groups.google.com/a/admb-project.org/g/users/c/63YJmYGEPuE |
|
| 69 |
*/ |
|
| 70 | 6x |
void PrepareConstrainedDeviations() {
|
| 71 | 6x |
if (!this->constrain_deviations) {
|
| 72 | 3x |
return; |
| 73 |
} |
|
| 74 | ||
| 75 | 3x |
Type sum = 0.0; |
| 76 | ||
| 77 | 12x |
for (size_t i = 0; i < this->log_recruit_devs.size(); i++) {
|
| 78 | 9x |
sum += this->log_recruit_devs[i]; |
| 79 |
} |
|
| 80 | ||
| 81 | 12x |
for (size_t i = 0; i < this->log_recruit_devs.size(); i++) {
|
| 82 | 9x |
this->log_recruit_devs[i] -= sum / (this->log_recruit_devs.size()); |
| 83 |
} |
|
| 84 |
} |
|
| 85 |
}; |
|
| 86 | ||
| 87 |
template <class Type> |
|
| 88 |
uint32_t RecruitmentBase<Type>::id_g = 0; |
|
| 89 |
} // namespace fims_popdy |
|
| 90 | ||
| 91 |
#endif /* FIMS_POPULATION_DYNAMICS_RECRUITMENT_BASE_HPP */ |
| 1 |
/** |
|
| 2 |
* @file sr_beverton_holt.hpp |
|
| 3 |
* @brief Calls the Beverton--Holt stock--recruitment function from fims_math |
|
| 4 |
* and does the calculation. |
|
| 5 |
* @details This function inherits from recruitment base. |
|
| 6 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 7 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 8 |
* folder for reuse information. |
|
| 9 |
*/ |
|
| 10 |
#ifndef FIMS_POPULATION_DYNAMICS_RECRUITMENT_SR_BEVERTON_HOLT_HPP |
|
| 11 |
#define FIMS_POPULATION_DYNAMICS_RECRUITMENT_SR_BEVERTON_HOLT_HPP |
|
| 12 | ||
| 13 |
#include "recruitment_base.hpp" |
|
| 14 |
#include "../../../common/fims_vector.hpp" |
|
| 15 | ||
| 16 |
namespace fims_popdy {
|
|
| 17 | ||
| 18 |
/** @brief BevertonHolt class that returns the Beverton--Holt |
|
| 19 |
* stock--recruitment from fims_math. |
|
| 20 |
* |
|
| 21 |
* @param logit_steep Recruitment relative to unfished recruitment at 20 |
|
| 22 |
* percent of unfished spawning biomass. Steepness is subject to a logit |
|
| 23 |
* transformation to keep it between 0.2 and 1.0. |
|
| 24 |
*/ |
|
| 25 |
template <typename Type> |
|
| 26 |
struct SRBevertonHolt : public RecruitmentBase<Type> {
|
|
| 27 |
// Here we define the members that will be used in the Beverton--Holt |
|
| 28 |
// stock--recruitment function. These members are needed by the Beverton--Holt |
|
| 29 |
// stock--recruitment function but will not be common to all recruitment |
|
| 30 |
// functions like spawners is below. |
|
| 31 |
fims::Vector<Type> logit_steep; /**< Transformed value of recruitment |
|
| 32 |
relative to unfished |
|
| 33 |
recruitment at 20 percent of unfished |
|
| 34 |
spawning biomass.*/ |
|
| 35 | ||
| 36 | 92x |
SRBevertonHolt() : RecruitmentBase<Type>() {}
|
| 37 | ||
| 38 | 92x |
virtual ~SRBevertonHolt() {}
|
| 39 | ||
| 40 |
/** @brief Beverton--Holt implementation of the stock--recruitment function. |
|
| 41 |
* |
|
| 42 |
* The Beverton--Holt stock--recruitment implementation: |
|
| 43 |
* \f$ \frac{0.8 R_{0} h S_{t-1}}{0.2 R_{0} \phi_{0} (1 - h) + S_{t-1} (h -
|
|
| 44 |
* 0.2)} \f$ |
|
| 45 |
* |
|
| 46 |
* @param spawners A measure of spawning output. |
|
| 47 |
* @param phi_0 Number of spawners per recruit of an unfished population |
|
| 48 |
*/ |
|
| 49 | 129x |
virtual const Type evaluate(const Type& spawners, const Type& phi_0) {
|
| 50 | ! |
Type recruits; |
| 51 | ! |
Type steep; |
| 52 | 129x |
Type steep_lo = 0.2; |
| 53 | 129x |
Type steep_hi = 1.0; |
| 54 | ! |
Type rzero; |
| 55 | ||
| 56 |
// Transform input parameters |
|
| 57 | 129x |
steep = fims_math::inv_logit(steep_lo, steep_hi, this->logit_steep[0]); |
| 58 | 129x |
rzero = fims_math::exp(this->log_rzero[0]); |
| 59 | ||
| 60 | 258x |
recruits = (0.8 * rzero * steep * spawners) / |
| 61 | 129x |
(0.2 * phi_0 * rzero * (1.0 - steep) + spawners * (steep - 0.2)); |
| 62 | ||
| 63 | 129x |
return recruits; |
| 64 |
} |
|
| 65 |
}; |
|
| 66 | ||
| 67 |
} // namespace fims_popdy |
|
| 68 | ||
| 69 |
#endif /* FIMS_POPULATION_DYNAMICS_RECRUITMENT_SR_BEVERTON_HOLT_HPP */ |
| 1 |
/** |
|
| 2 |
* @file logistic.hpp |
|
| 3 |
* @brief Declares the LogisticSelectivity class which implements the logistic |
|
| 4 |
* function from fims_math in the selectivity module. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef POPULATION_DYNAMICS_SELECTIVITY_LOGISTIC_HPP |
|
| 10 |
#define POPULATION_DYNAMICS_SELECTIVITY_LOGISTIC_HPP |
|
| 11 | ||
| 12 |
//#include "../../../interface/interface.hpp" |
|
| 13 |
#include "../../../common/fims_math.hpp" |
|
| 14 |
#include "../../../common/fims_vector.hpp" |
|
| 15 |
#include "selectivity_base.hpp" |
|
| 16 | ||
| 17 |
namespace fims_popdy {
|
|
| 18 | ||
| 19 |
/** |
|
| 20 |
* @brief LogisticSelectivity class that returns the logistic function value |
|
| 21 |
* from fims_math. |
|
| 22 |
*/ |
|
| 23 |
template <typename Type> |
|
| 24 |
struct LogisticSelectivity : public SelectivityBase<Type> {
|
|
| 25 |
fims::Vector<Type> inflection_point; /**< 50% quantile of the value of the quantity of |
|
| 26 |
interest (x); e.g. age at which 50% of the fish are selected */ |
|
| 27 |
fims::Vector<Type> slope; /**<scalar multiplier of difference between quantity of interest |
|
| 28 |
value (x) and inflection_point */ |
|
| 29 | ||
| 30 | 267x |
LogisticSelectivity() : SelectivityBase<Type>() |
| 31 |
{
|
|
| 32 |
} |
|
| 33 | ||
| 34 | 178x |
virtual ~LogisticSelectivity() |
| 35 |
{
|
|
| 36 |
} |
|
| 37 | ||
| 38 |
/** |
|
| 39 |
* @brief Method of the logistic selectivity class that implements the |
|
| 40 |
* logistic function from FIMS math. |
|
| 41 |
* |
|
| 42 |
* \f[ \frac{1.0}{ 1.0 + exp(-1.0 * slope (x - inflection\_point))} \f]
|
|
| 43 |
* |
|
| 44 |
* @param x The independent variable in the logistic function (e.g., age or |
|
| 45 |
* size in selectivity). |
|
| 46 |
*/ |
|
| 47 | 7986x |
virtual const Type evaluate(const Type& x) |
| 48 |
{
|
|
| 49 | 7986x |
return fims_math::logistic<Type>(inflection_point[0], slope[0], x); |
| 50 |
} |
|
| 51 | ||
| 52 |
/** |
|
| 53 |
* @brief Method of the logistic selectivity class that implements the |
|
| 54 |
* logistic function from FIMS math. |
|
| 55 |
* |
|
| 56 |
* \f[ \frac{1.0}{ 1.0 + exp(-1.0 * slope_t (x - {inflection\_point}_t))} \f]
|
|
| 57 |
* |
|
| 58 |
* @param x The independent variable in the logistic function (e.g., age or |
|
| 59 |
* size in selectivity). |
|
| 60 |
* @param pos Position index, e.g., which year. |
|
| 61 |
*/ |
|
| 62 | ! |
virtual const Type evaluate(const Type& x, size_t pos) |
| 63 |
{
|
|
| 64 | ! |
return fims_math::logistic<Type>(inflection_point.get_force_scalar(pos), slope.get_force_scalar(pos), x); |
| 65 |
} |
|
| 66 |
}; |
|
| 67 | ||
| 68 |
} // namespace fims_popdy |
|
| 69 | ||
| 70 |
#endif /* POPULATION_DYNAMICS_SELECTIVITY_LOGISTIC_HPP */ |
| 1 |
/** |
|
| 2 |
* @file selectivity_base.hpp |
|
| 3 |
* @brief Declares the SelectivityBase class which is the base class for all |
|
| 4 |
* selectivity functors. |
|
| 5 |
* @details Defines guards for selectivity module outline to define the |
|
| 6 |
* selectivity hpp file if not already defined. |
|
| 7 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 8 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 9 |
* folder for reuse information. |
|
| 10 |
*/ |
|
| 11 |
#ifndef POPULATION_DYNAMICS_SELECTIVITY_BASE_HPP |
|
| 12 |
#define POPULATION_DYNAMICS_SELECTIVITY_BASE_HPP |
|
| 13 | ||
| 14 |
#include "../../../common/model_object.hpp" |
|
| 15 | ||
| 16 |
namespace fims_popdy {
|
|
| 17 | ||
| 18 |
/** @brief Base class for all selectivity functors. |
|
| 19 |
* |
|
| 20 |
* @tparam Type The type of the selectivity functor. |
|
| 21 |
*/ |
|
| 22 | ||
| 23 |
template <typename Type> |
|
| 24 |
struct SelectivityBase : public fims_model_object::FIMSObject<Type> {
|
|
| 25 |
// id_g is the ID of the instance of the SelectivityBase class. |
|
| 26 |
// this is like a memory tracker. |
|
| 27 |
// Assigning each one its own ID is a way to keep track of |
|
| 28 |
// all the instances of the SelectivityBase class. |
|
| 29 |
static uint32_t |
|
| 30 |
id_g; /**< The ID of the instance of the SelectivityBase class */ |
|
| 31 | ||
| 32 |
/** @brief Constructor. |
|
| 33 |
*/ |
|
| 34 | 92x |
SelectivityBase() {
|
| 35 |
// increment id of the singleton selectivity class |
|
| 36 | 92x |
this->id = SelectivityBase::id_g++; |
| 37 |
} |
|
| 38 | ||
| 39 | 92x |
virtual ~SelectivityBase() {}
|
| 40 | ||
| 41 |
/** |
|
| 42 |
* @brief Calculates the selectivity. |
|
| 43 |
* @param x The independent variable in the logistic function (e.g., age or |
|
| 44 |
* size in selectivity). |
|
| 45 |
*/ |
|
| 46 |
virtual const Type evaluate(const Type& x) = 0; |
|
| 47 |
|
|
| 48 |
/** |
|
| 49 |
* @brief Calculates the selectivity. |
|
| 50 |
* @param x The independent variable in the logistic function (e.g., age or |
|
| 51 |
* size in selectivity). |
|
| 52 |
* @param pos Position index, e.g., which year. |
|
| 53 |
*/ |
|
| 54 |
virtual const Type evaluate(const Type& x, size_t pos) = 0; |
|
| 55 |
}; |
|
| 56 | ||
| 57 |
// default id of the singleton selectivity class |
|
| 58 |
template <typename Type> |
|
| 59 |
uint32_t SelectivityBase<Type>::id_g = 0; |
|
| 60 | ||
| 61 |
} // namespace fims_popdy |
|
| 62 | ||
| 63 |
#endif /* POPULATION_DYNAMICS_SELECTIVITY_BASE_HPP */ |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/population/population.hpp" |
|
| 3 |
#include "../../tests/gtest/test_population_test_fixture.hpp" |
|
| 4 | ||
| 5 |
namespace |
|
| 6 |
{
|
|
| 7 | 25x |
TEST_F(PopulationEvaluateTestFixture, CalculateB_and_SB_works) |
| 8 |
{
|
|
| 9 | 3x |
population.CalculateMaturityAA(i_age_year, age); |
| 10 | 3x |
population.CalculateSpawningBiomass(i_age_year, year, age); |
| 11 | 3x |
population.CalculateBiomass(i_age_year, year, age); |
| 12 | ||
| 13 | 3x |
std::vector<double> test_SB(nyears + 1, 0); |
| 14 | 3x |
std::vector<double> test_B(nyears + 1, 0); |
| 15 | ||
| 16 | 3x |
test_SB[year] += population.numbers_at_age[i_age_year] * population.proportion_female[age] * population.proportion_mature_at_age[i_age_year] * |
| 17 | 3x |
population.growth->evaluate(population.ages[age]); |
| 18 | 3x |
test_B[year] += population.numbers_at_age[i_age_year] * |
| 19 | 3x |
population.growth->evaluate(population.ages[age]); |
| 20 | ||
| 21 | 3x |
EXPECT_EQ(population.spawning_biomass[year], test_SB[year]); |
| 22 | 3x |
EXPECT_GT(population.spawning_biomass[year], 0); |
| 23 | ||
| 24 | 3x |
EXPECT_EQ(population.biomass[year], test_B[year]); |
| 25 | 3x |
EXPECT_GT(population.biomass[year], 0); |
| 26 |
} |
|
| 27 | ||
| 28 | 25x |
TEST_F(PopulationEvaluateTestFixture, CalculateSpawningBiomass_ExtraYear_works) |
| 29 |
{
|
|
| 30 | ||
| 31 | 3x |
int year = population.nyears; |
| 32 | 3x |
int age = 6; |
| 33 | 3x |
int i_age_year = year * population.nages + age; |
| 34 | 3x |
int i_agem1_yearm1 = (year - 1) * population.nages + age - 1; |
| 35 | ||
| 36 | 3x |
population.CalculateMortality(i_agem1_yearm1, year-1, age-1); |
| 37 | 3x |
population.CalculateMaturityAA(i_age_year, age); |
| 38 | 3x |
population.CalculateNumbersAA(i_age_year, i_agem1_yearm1, age); |
| 39 | 3x |
population.CalculateSpawningBiomass(i_age_year, year, age); |
| 40 | ||
| 41 | 3x |
std::vector<double> test_SSB(nyears + 1, 0); |
| 42 | ||
| 43 | 6x |
test_SSB[nyears] += population.numbers_at_age[i_age_year] * population.proportion_female[age] * |
| 44 | 3x |
population.proportion_mature_at_age[i_age_year] * |
| 45 | 3x |
population.growth->evaluate(population.ages[age]); |
| 46 | ||
| 47 | 3x |
EXPECT_EQ(population.spawning_biomass[year], test_SSB[year]); |
| 48 | 3x |
EXPECT_GT(population.spawning_biomass[year], 0); |
| 49 |
} |
|
| 50 |
} |
| 1 |
#include <random> |
|
| 2 | ||
| 3 |
#include "population_dynamics/population/population.hpp" |
|
| 4 | ||
| 5 | ||
| 6 | ||
| 7 | ||
| 8 |
namespace {
|
|
| 9 | ||
| 10 |
// Use test fixture to reuse the same configuration of objects for |
|
| 11 |
// several different tests. To use a test fixture, derive a class |
|
| 12 |
// from testing::Test. |
|
| 13 | 6x |
class PopulationInitializeTestFixture : public testing::Test {
|
| 14 |
// Make members protected and they can be accessed from |
|
| 15 |
// sub-classes. |
|
| 16 |
protected: |
|
| 17 |
// Use SetUp function to prepare the objects for each test. |
|
| 18 |
// Use override in C++11 to make sure SetUp (e.g., not Setup with |
|
| 19 |
// a lowercase u) is spelled |
|
| 20 |
// correctly. |
|
| 21 | 6x |
void SetUp() override {
|
| 22 | 6x |
population.id_g = id_g; |
| 23 | 6x |
population.nyears = nyears; |
| 24 | 6x |
population.nseasons = nseasons; |
| 25 | 6x |
population.nages = nages; |
| 26 | 18x |
for (int i = 0; i < nfleets; i++) {
|
| 27 | 12x |
auto fleet = std::make_shared<fims_popdy::Fleet<double>>(); |
| 28 | 12x |
fleet->log_q.resize(1); |
| 29 | 12x |
population.fleets.push_back(fleet); |
| 30 |
} |
|
| 31 |
} |
|
| 32 | ||
| 33 |
// Virtual void TearDown() will be called after each test is |
|
| 34 |
// run. It needs to be defined if there is clearup work to |
|
| 35 |
// do. Otherwise, it does not need to be provided. |
|
| 36 | 6x |
virtual void TearDown() {}
|
| 37 | ||
| 38 |
fims_popdy::Population<double> population; |
|
| 39 | ||
| 40 |
// Use default values from the Li et al., 2021 |
|
| 41 |
// https://github.com/Bai-Li-NOAA/Age_Structured_Stock_Assessment_Model_Comparison/blob/master/R/save_initial_input.R |
|
| 42 | 6x |
int id_g = 0; |
| 43 | 6x |
int nyears = 30; |
| 44 | 6x |
int nseasons = 1; |
| 45 | 6x |
int nages = 12; |
| 46 | 6x |
int nfleets = 2; |
| 47 |
}; |
|
| 48 | ||
| 49 | 33x |
class PopulationEvaluateTestFixture : public testing::Test {
|
| 50 |
protected: |
|
| 51 | 33x |
void SetUp() override {
|
| 52 | 33x |
population.id_g = id_g; |
| 53 | 33x |
population.nyears = nyears; |
| 54 | 33x |
population.nseasons = nseasons; |
| 55 | 33x |
population.nages = nages; |
| 56 | 33x |
population.nfleets = nfleets; |
| 57 | ||
| 58 |
// C++ code to set up true values for log_naa, log_M, |
|
| 59 |
// log_Fmort, and log_q: |
|
| 60 | 33x |
int seed = 1234; |
| 61 | 33x |
std::default_random_engine generator(seed); |
| 62 | ||
| 63 |
// log_Fmort |
|
| 64 | 33x |
double log_Fmort_min = fims_math::log(0.1); |
| 65 | 33x |
double log_Fmort_max = fims_math::log(2.3); |
| 66 | 33x |
std::uniform_real_distribution<double> log_Fmort_distribution( |
| 67 | 33x |
log_Fmort_min, log_Fmort_max); |
| 68 | ||
| 69 |
// log_q |
|
| 70 | 33x |
double log_q_min = fims_math::log(0.1); |
| 71 | 33x |
double log_q_max = fims_math::log(1); |
| 72 | 66x |
std::uniform_real_distribution<double> log_q_distribution(log_q_min, |
| 73 | 33x |
log_q_max); |
| 74 | ||
| 75 |
// Make a shared pointer to selectivity and fleet because |
|
| 76 |
// fleet object needs a shared pointer in fleet.hpp |
|
| 77 |
// (std::shared_ptr<fims_popdy::SelectivityBase<Type> > selectivity;) |
|
| 78 |
// and population object needs a shared pointer in population.hpp |
|
| 79 |
// (std::vector<std::shared_ptr<fims_popdy::Fleet<Type> > > fleets;) |
|
| 80 | ||
| 81 |
// Does Fmort need to be in side of the year loop like log_q? |
|
| 82 | 99x |
for (int i = 0; i < nfleets; i++) {
|
| 83 | 66x |
auto fleet = std::make_shared<fims_popdy::Fleet<double>>(); |
| 84 |
auto selectivity = |
|
| 85 | 66x |
std::make_shared<fims_popdy::LogisticSelectivity<double>>(); |
| 86 | 66x |
selectivity->inflection_point.resize(1); |
| 87 | 66x |
selectivity->inflection_point[0] = 7; |
| 88 | 66x |
selectivity->slope.resize(1); |
| 89 | 66x |
selectivity->slope[0] = 0.5; |
| 90 | ||
| 91 | 66x |
fleet->expected_catch.resize(nyears); |
| 92 | 66x |
fleet->expected_index.resize(nyears); |
| 93 | 66x |
fleet->catch_numbers_at_age.resize(nyears * nages); |
| 94 | 66x |
fleet->log_q.resize(1); |
| 95 | 66x |
fleet->Initialize(nyears, nages); |
| 96 | 66x |
fleet->selectivity = selectivity; |
| 97 | 66x |
fleet->log_q[0] = log_q_distribution(generator); |
| 98 | 2046x |
for (int year = 0; year < nyears; year++) {
|
| 99 | 1980x |
fleet->log_Fmort[year] = log_Fmort_distribution(generator); |
| 100 |
} |
|
| 101 | 66x |
if (i == 0) {
|
| 102 | 33x |
fleet->is_survey = true; |
| 103 |
} |
|
| 104 | 66x |
fleet->Prepare(); |
| 105 | 66x |
population.fleets.push_back(fleet); |
| 106 |
} |
|
| 107 | 33x |
population.numbers_at_age.resize((nyears + 1) * nages); |
| 108 |
try {
|
|
| 109 | 33x |
population.Initialize(nyears, nseasons, nages); |
| 110 | 33x |
} catch (std::exception& e) {
|
| 111 | ! |
std::cout << e.what() << "\n"; |
| 112 |
} |
|
| 113 | ||
| 114 | 429x |
for (int i = 0; i < nages; i++) {
|
| 115 | 396x |
population.ages[i] = i + 1; |
| 116 |
} |
|
| 117 | ||
| 118 |
// log_naa |
|
| 119 | 33x |
double log_init_naa_min = 10.0; |
| 120 | 33x |
double log_init_naa_max = 12.0; |
| 121 | 33x |
std::uniform_real_distribution<double> log_naa_distribution( |
| 122 | 33x |
log_init_naa_min, log_init_naa_max); |
| 123 | 429x |
for (int i = 0; i < nages; i++) {
|
| 124 | 396x |
population.log_init_naa[i] = log_naa_distribution(generator); |
| 125 |
} |
|
| 126 | ||
| 127 |
// prop_female |
|
| 128 | 33x |
double prop_female_min = 0.1; |
| 129 | 33x |
double prop_female_max = 0.9; |
| 130 | 33x |
std::uniform_real_distribution<double> prop_female_distribution( |
| 131 | 33x |
prop_female_min, prop_female_max); |
| 132 | 429x |
for (int i = 0; i < nages; i++) {
|
| 133 | 396x |
population.proportion_female[i] = prop_female_distribution(generator); |
| 134 |
} |
|
| 135 | ||
| 136 |
// log_M |
|
| 137 | 33x |
double log_M_min = fims_math::log(0.1); |
| 138 | 33x |
double log_M_max = fims_math::log(0.3); |
| 139 | 66x |
std::uniform_real_distribution<double> log_M_distribution(log_M_min, |
| 140 | 33x |
log_M_max); |
| 141 | 11913x |
for (int i = 0; i < nyears * nages; i++) {
|
| 142 | 11880x |
population.log_M[i] = log_M_distribution(generator); |
| 143 |
} |
|
| 144 | ||
| 145 |
// numbers_at_age |
|
| 146 | 33x |
double numbers_at_age_min = fims_math::exp(10.0); |
| 147 | 33x |
double numbers_at_age_max = fims_math::exp(12.0); |
| 148 | 33x |
std::uniform_real_distribution<double> numbers_at_age_distribution( |
| 149 | 33x |
numbers_at_age_min, numbers_at_age_max); |
| 150 | 12309x |
for (int i = 0; i < (nyears + 1) * nages; i++) {
|
| 151 | 12276x |
population.numbers_at_age[i] = numbers_at_age_distribution(generator); |
| 152 |
} |
|
| 153 | ||
| 154 |
// weight_at_age |
|
| 155 | 33x |
double weight_at_age_min = 0.5; |
| 156 | 33x |
double weight_at_age_max = 12.0; |
| 157 | ||
| 158 |
std::shared_ptr<fims_popdy::EWAAgrowth<double>> growth = |
|
| 159 | 33x |
std::make_shared<fims_popdy::EWAAgrowth<double>>(); |
| 160 | 33x |
std::uniform_real_distribution<double> weight_at_age_distribution( |
| 161 | 33x |
weight_at_age_min, weight_at_age_max); |
| 162 | 429x |
for (int i = 0; i < nages; i++) {
|
| 163 | 396x |
growth->ewaa[static_cast<double>(population.ages[i])] = |
| 164 | 396x |
weight_at_age_distribution(generator); |
| 165 |
} |
|
| 166 | ||
| 167 | 33x |
population.growth = growth; |
| 168 | 33x |
population.Prepare(); |
| 169 | ||
| 170 | 33x |
auto maturity = std::make_shared<fims_popdy::LogisticMaturity<double>>(); |
| 171 | 33x |
maturity->inflection_point.resize(1); |
| 172 | 33x |
maturity->inflection_point[0] = 6; |
| 173 | 33x |
maturity->slope.resize(1); |
| 174 | 33x |
maturity->slope[0] = 0.15; |
| 175 | 33x |
population.maturity = maturity; |
| 176 | ||
| 177 | 33x |
auto recruitment = std::make_shared<fims_popdy::SRBevertonHolt<double>>(); |
| 178 | 33x |
recruitment->logit_steep.resize(1); |
| 179 | 33x |
recruitment->log_rzero.resize(1); |
| 180 | 33x |
recruitment->logit_steep[0] = fims_math::logit(0.2, 1.0, 0.75); |
| 181 | 33x |
recruitment->log_rzero[0] = fims_math::log(1000000.0); |
| 182 |
/*the log_recruit_dev vector does not include a value for year == 0 |
|
| 183 |
and is of length nyears - 1 where the first position of the vector |
|
| 184 |
corresponds to the second year of the time series.*/ |
|
| 185 | 33x |
recruitment->log_recruit_devs.resize(nyears - 1); |
| 186 | 990x |
for (int i = 0; i < recruitment->log_recruit_devs.size(); i++) {
|
| 187 | 957x |
recruitment->log_recruit_devs[i] = 0.0; |
| 188 |
} |
|
| 189 | 33x |
population.recruitment = recruitment; |
| 190 | ||
| 191 | 33x |
int year = 4; |
| 192 | 33x |
int age = 6; |
| 193 | 33x |
int i_age_year = year * population.nages + age; |
| 194 | 33x |
int i_agem1_yearm1 = (year - 1) * population.nages + age - 1; |
| 195 | ||
| 196 | 33x |
population.CalculateMortality(i_age_year, year, age); |
| 197 | 33x |
population.CalculateNumbersAA(i_age_year, i_agem1_yearm1, age); |
| 198 |
} |
|
| 199 | ||
| 200 | 33x |
virtual void TearDown() {}
|
| 201 | ||
| 202 |
fims_popdy::Population<double> population; |
|
| 203 | 33x |
int id_g = 0; |
| 204 | 33x |
int nyears = 30; |
| 205 | 33x |
int nseasons = 1; |
| 206 | 33x |
int nages = 12; |
| 207 | 33x |
int nfleets = 2; |
| 208 | ||
| 209 | 33x |
int year = 4; |
| 210 | 33x |
int age = 6; |
| 211 | 33x |
int i_age_year = year * nages + age; |
| 212 | 33x |
int i_agem1_yearm1 = (year - 1) * nages + age - 1; |
| 213 |
}; |
|
| 214 | ||
| 215 | 6x |
class PopulationPrepareTestFixture : public testing::Test {
|
| 216 |
protected: |
|
| 217 | 6x |
void SetUp() override {
|
| 218 | 6x |
population.id_g = id_g; |
| 219 | 6x |
population.nyears = nyears; |
| 220 | 6x |
population.nseasons = nseasons; |
| 221 | 6x |
population.nages = nages; |
| 222 | 6x |
population.nfleets = nfleets; |
| 223 | ||
| 224 |
// C++ code to set up true values for log_Fmort, and log_q: |
|
| 225 | 6x |
int seed = 1234; |
| 226 | 6x |
std::default_random_engine generator(seed); |
| 227 | ||
| 228 |
// log_Fmort |
|
| 229 | 6x |
double log_Fmort_min = fims_math::log(0.1); |
| 230 | 6x |
double log_Fmort_max = fims_math::log(2.3); |
| 231 | 6x |
std::uniform_real_distribution<double> log_Fmort_distribution( |
| 232 | 6x |
log_Fmort_min, log_Fmort_max); |
| 233 | ||
| 234 |
// log_q |
|
| 235 | 6x |
double log_q_min = fims_math::log(0.1); |
| 236 | 6x |
double log_q_max = fims_math::log(1); |
| 237 | 12x |
std::uniform_real_distribution<double> log_q_distribution(log_q_min, |
| 238 | 6x |
log_q_max); |
| 239 | ||
| 240 |
// Make a shared pointer to selectivity and fleet because |
|
| 241 |
// fleet object needs a shared pointer in fleet.hpp |
|
| 242 |
// (std::shared_ptr<fims::SelectivityBase<Type> > selectivity;) |
|
| 243 |
// and population object needs a shared pointer in population.hpp |
|
| 244 |
// (std::vector<std::shared_ptr<fims::Fleet<Type> > > fleets;) |
|
| 245 | ||
| 246 | 18x |
for (int i = 0; i < nfleets; i++) {
|
| 247 | 12x |
auto fleet = std::make_shared<fims_popdy::Fleet<double>>(); |
| 248 |
auto selectivity = |
|
| 249 | 12x |
std::make_shared<fims_popdy::LogisticSelectivity<double>>(); |
| 250 | 12x |
selectivity->inflection_point.resize(1); |
| 251 | 12x |
selectivity->slope.resize(1); |
| 252 | 12x |
selectivity->inflection_point[0] = 7; |
| 253 | 12x |
selectivity->slope[0] = 0.5; |
| 254 |
|
|
| 255 | 12x |
fleet->expected_catch.resize(nyears); |
| 256 | 12x |
fleet->expected_index.resize(nyears); |
| 257 | 12x |
fleet->catch_numbers_at_age.resize(nyears * nages); |
| 258 | 12x |
fleet->log_q.resize(1); |
| 259 | 12x |
fleet->Initialize(nyears, nages); |
| 260 | 12x |
fleet->selectivity = selectivity; |
| 261 | 12x |
fleet->log_q[0] = log_q_distribution(generator); |
| 262 | 372x |
for (int year = 0; year < nyears; year++) {
|
| 263 | 360x |
fleet->log_Fmort[year] = log_Fmort_distribution(generator); |
| 264 |
} |
|
| 265 | 12x |
if (i == 0) {
|
| 266 | 6x |
fleet->is_survey = true; |
| 267 |
} |
|
| 268 | 12x |
fleet->Prepare(); |
| 269 | 12x |
population.fleets.push_back(fleet); |
| 270 |
} |
|
| 271 | ||
| 272 | 6x |
population.numbers_at_age.resize((nyears + 1) * nages); |
| 273 | 6x |
population.Initialize(nyears, nseasons, nages); |
| 274 | ||
| 275 | 78x |
for (int i = 0; i < nages; i++) {
|
| 276 | 72x |
population.ages[i] = i + 1; |
| 277 |
} |
|
| 278 | ||
| 279 |
// log_naa |
|
| 280 | 6x |
double log_init_naa_min = 10.0; |
| 281 | 6x |
double log_init_naa_max = 12.0; |
| 282 | 6x |
std::uniform_real_distribution<double> log_naa_distribution( |
| 283 | 6x |
log_init_naa_min, log_init_naa_max); |
| 284 | 78x |
for (int i = 0; i < nages; i++) {
|
| 285 | 72x |
population.log_init_naa[i] = log_naa_distribution(generator); |
| 286 |
} |
|
| 287 | ||
| 288 |
// prop_female |
|
| 289 | 6x |
double prop_female_min = 0.1; |
| 290 | 6x |
double prop_female_max = 0.9; |
| 291 | 6x |
std::uniform_real_distribution<double> prop_female_distribution( |
| 292 | 6x |
prop_female_min, prop_female_max); |
| 293 | 78x |
for (int i = 0; i < nages; i++) {
|
| 294 | 72x |
population.proportion_female[i] = prop_female_distribution(generator); |
| 295 |
} |
|
| 296 | ||
| 297 |
// log_M |
|
| 298 | 6x |
double log_M_min = fims_math::log(0.1); |
| 299 | 6x |
double log_M_max = fims_math::log(0.3); |
| 300 | 12x |
std::uniform_real_distribution<double> log_M_distribution(log_M_min, |
| 301 | 6x |
log_M_max); |
| 302 | 2166x |
for (int i = 0; i < nyears * nages; i++) {
|
| 303 | 2160x |
population.log_M[i] = log_M_distribution(generator); |
| 304 |
} |
|
| 305 | ||
| 306 |
// numbers_at_age |
|
| 307 | 6x |
double numbers_at_age_min = fims_math::exp(10.0); |
| 308 | 6x |
double numbers_at_age_max = fims_math::exp(12.0); |
| 309 | 6x |
std::uniform_real_distribution<double> numbers_at_age_distribution( |
| 310 | 6x |
numbers_at_age_min, numbers_at_age_max); |
| 311 | 2238x |
for (int i = 0; i < (nyears + 1) * nages; i++) {
|
| 312 | 2232x |
population.numbers_at_age[i] = numbers_at_age_distribution(generator); |
| 313 |
} |
|
| 314 | ||
| 315 |
// weight_at_age |
|
| 316 | 6x |
double weight_at_age_min = 0.5; |
| 317 | 6x |
double weight_at_age_max = 12.0; |
| 318 | ||
| 319 |
std::shared_ptr<fims_popdy::EWAAgrowth<double>> growth = |
|
| 320 | 6x |
std::make_shared<fims_popdy::EWAAgrowth<double>>(); |
| 321 | 6x |
std::uniform_real_distribution<double> weight_at_age_distribution( |
| 322 | 6x |
weight_at_age_min, weight_at_age_max); |
| 323 | 78x |
for (int i = 0; i < nages; i++) {
|
| 324 | 72x |
growth->ewaa[static_cast<double>(population.ages[i])] = |
| 325 | 72x |
weight_at_age_distribution(generator); |
| 326 |
} |
|
| 327 | ||
| 328 | 6x |
population.growth = growth; |
| 329 | ||
| 330 | 6x |
population.Prepare(); |
| 331 |
} |
|
| 332 | ||
| 333 | 6x |
virtual void TearDown() {}
|
| 334 | ||
| 335 |
fims_popdy::Population<double> population; |
|
| 336 | 6x |
int id_g = 0; |
| 337 | 6x |
int nyears = 30; |
| 338 | 6x |
int nseasons = 1; |
| 339 | 6x |
int nages = 12; |
| 340 | 6x |
int nfleets = 2; |
| 341 |
}; |
|
| 342 |
} // namespace |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/population/population.hpp" |
|
| 3 |
#include "../../tests/gtest/test_population_test_fixture.hpp" |
|
| 4 | ||
| 5 |
namespace |
|
| 6 |
{
|
|
| 7 | ||
| 8 | 22x |
TEST_F(PopulationEvaluateTestFixture, CalculateCatch_works) |
| 9 |
{
|
|
| 10 | ||
| 11 | 3x |
std::vector<double> expected_catch(nyears * nfleets, 0); |
| 12 |
// calculate catch numbers at age in population module |
|
| 13 | 3x |
population.CalculateCatchNumbersAA(i_age_year, year, age); |
| 14 |
|
|
| 15 | 3x |
population.CalculateCatchWeightAA(year, age); |
| 16 | 3x |
population.CalculateCatch(year, age); |
| 17 | ||
| 18 | 9x |
for (int fleet_ = 0; fleet_ < population.nfleets; fleet_++) |
| 19 |
{
|
|
| 20 | 6x |
if(!population.fleets[fleet_]->is_survey){
|
| 21 | 3x |
int index_yf = year * population.nfleets + fleet_; |
| 22 |
|
|
| 23 | 3x |
expected_catch[index_yf] += population.fleets[fleet_]->catch_weight_at_age[i_age_year]; |
| 24 |
|
|
| 25 | 3x |
EXPECT_EQ(population.expected_catch[index_yf], expected_catch[index_yf]); |
| 26 | 3x |
EXPECT_GT(population.expected_catch[index_yf], 0); |
| 27 | 3x |
EXPECT_GT(expected_catch[index_yf], 0); |
| 28 | 3x |
EXPECT_EQ(expected_catch[index_yf], population.fleets[fleet_]->expected_catch[year]); |
| 29 |
} |
|
| 30 |
} |
|
| 31 |
} |
|
| 32 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/population/population.hpp" |
|
| 3 |
#include "../../tests/gtest/test_population_test_fixture.hpp" |
|
| 4 | ||
| 5 |
namespace |
|
| 6 |
{
|
|
| 7 | 22x |
TEST_F(PopulationEvaluateTestFixture, CalculateCatchNumbersAA_CalculateCatchWeightAA_works) |
| 8 |
{
|
|
| 9 |
// calculate catch numbers at age in population module |
|
| 10 | 3x |
population.CalculateCatchNumbersAA(i_age_year, year, age); |
| 11 | ||
| 12 | 3x |
population.CalculateCatchWeightAA(year, age); |
| 13 | ||
| 14 | 3x |
std::vector<double> mortality_F(nyears * nages, 0); |
| 15 |
// dimension of test_catch_naa matches population module, not |
|
| 16 |
// fleet module |
|
| 17 | 3x |
std::vector<double> test_catch_naa(nyears * nages * nfleets, 0); |
| 18 | 3x |
std::vector<double> test_catch_waa(nyears * nages * nfleets, 0); |
| 19 | 3x |
std::vector<double> test_naa((nyears + 1) * nages, 0); |
| 20 |
|
|
| 21 |
double catch_temp; |
|
| 22 | ||
| 23 | 1119x |
for (int i = 0; i < (nyears + 1) * nages; i++) |
| 24 |
{
|
|
| 25 | 1116x |
test_naa[i] = population.numbers_at_age[i]; |
| 26 |
} |
|
| 27 | 3x |
test_naa[i_age_year] = test_naa[i_agem1_yearm1] * exp(-population.mortality_Z[i_agem1_yearm1]); |
| 28 | ||
| 29 |
// loop over fleets to get catch numbers at age for each fleet |
|
| 30 | 9x |
for (size_t fleet_index = 0; fleet_index < population.nfleets; fleet_index++) |
| 31 |
{
|
|
| 32 |
|
|
| 33 | 6x |
if(!population.fleets[fleet_index]->is_survey){
|
| 34 |
// indices for use in catch equation copied from |
|
| 35 |
// \inst\include\population_dynamics\population\population.hpp |
|
| 36 | 9x |
int i_age_yearf = year * population.nages * population.nfleets + |
| 37 | 6x |
age * population.nfleets + fleet_index; |
| 38 | ||
| 39 |
// Baranov Catch Equation adapted from |
|
| 40 |
// \inst\include\population_dynamics\population\population.hpp |
|
| 41 | 3x |
catch_temp = |
| 42 | 3x |
(population.fleets[fleet_index]->Fmort[year] * |
| 43 | 3x |
population.fleets[fleet_index]->selectivity->evaluate(population.ages[age])) / |
| 44 | 6x |
population.mortality_Z[i_age_year] * |
| 45 | 6x |
test_naa[i_age_year] * |
| 46 | 3x |
(1 - exp(-(population.mortality_Z[i_age_year]))); |
| 47 | 3x |
test_catch_naa[i_age_yearf] += catch_temp; |
| 48 | 3x |
test_catch_waa[i_age_yearf] += catch_temp * population.growth->evaluate(population.ages[age]); |
| 49 | ||
| 50 |
// test value |
|
| 51 | 3x |
EXPECT_EQ(population.fleets[fleet_index]->catch_numbers_at_age[i_age_year], test_catch_naa[i_age_yearf]); |
| 52 | 3x |
EXPECT_EQ(population.fleets[fleet_index]->catch_weight_at_age[i_age_year], test_catch_waa[i_age_yearf]); |
| 53 | 3x |
EXPECT_GT(population.fleets[fleet_index]->catch_numbers_at_age[i_age_year], 0); |
| 54 | 3x |
EXPECT_GT(population.fleets[fleet_index]->catch_weight_at_age[i_age_year], 0); |
| 55 |
} |
|
| 56 |
} |
|
| 57 |
|
|
| 58 |
|
|
| 59 |
} |
|
| 60 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/fleet/fleet.hpp" |
|
| 3 |
#include <random> |
|
| 4 | ||
| 5 |
namespace |
|
| 6 |
{
|
|
| 7 | ||
| 8 | 25x |
TEST(FleetTests, FleetInitializeWorks) |
| 9 |
{
|
|
| 10 | 3x |
fims_popdy::Fleet<double> fleet; |
| 11 | 3x |
int nyears = 30; |
| 12 | 3x |
int nages = 12; |
| 13 | 3x |
fleet.expected_catch.resize(nyears); |
| 14 | 3x |
fleet.expected_index.resize(nyears); |
| 15 | 3x |
fleet.catch_numbers_at_age.resize(nyears * nages); |
| 16 | 3x |
fleet.Initialize(nyears, nages); |
| 17 | 3x |
fleet.Prepare(); |
| 18 |
|
|
| 19 |
|
|
| 20 | 3x |
EXPECT_EQ(fleet.log_Fmort.size(), nyears); |
| 21 | 3x |
EXPECT_EQ(fleet.Fmort.size(), nyears); |
| 22 | 3x |
EXPECT_EQ(fleet.catch_weight_at_age.size(), nyears*nages); |
| 23 | 3x |
EXPECT_EQ(fleet.catch_index.size(), nyears); |
| 24 |
} |
|
| 25 | ||
| 26 | 25x |
TEST(FleetTests, FleetPrepareWorks) |
| 27 |
{
|
|
| 28 | 3x |
fims_popdy::Fleet<double> fleet; |
| 29 | 3x |
int nyears = 30; |
| 30 | 3x |
int nages = 12; |
| 31 | 3x |
fleet.expected_catch.resize(nyears); |
| 32 | 3x |
fleet.expected_index.resize(nyears); |
| 33 | 3x |
fleet.catch_numbers_at_age.resize(nyears * nages); |
| 34 | 3x |
fleet.log_q.resize(1);//needs to be initialized here, size used by q in Initialize |
| 35 | 3x |
fleet.Initialize(nyears, nages); |
| 36 | ||
| 37 | 3x |
int seed = 1234; |
| 38 | 3x |
std::default_random_engine generator(seed); |
| 39 | ||
| 40 |
// log_Fmort |
|
| 41 | 3x |
double log_Fmort_min = fims_math::log(0.1); |
| 42 | 3x |
double log_Fmort_max = fims_math::log(2.3); |
| 43 | 3x |
std::uniform_real_distribution<double> log_Fmort_distribution(log_Fmort_min, log_Fmort_max); |
| 44 | ||
| 45 | 3x |
double log_q_min = fims_math::log(0.1); |
| 46 | 3x |
double log_q_max = fims_math::log(1); |
| 47 | 3x |
std::uniform_real_distribution<double> log_q_distribution(log_q_min, log_q_max); |
| 48 |
|
|
| 49 | 3x |
fleet.log_q[0] = log_q_distribution(generator); |
| 50 | 93x |
for(int i = 0; i < nyears; i++) |
| 51 |
{
|
|
| 52 | 90x |
fleet.log_Fmort[i] = log_Fmort_distribution(generator); |
| 53 |
} |
|
| 54 |
|
|
| 55 | 3x |
fleet.Prepare(); |
| 56 | ||
| 57 |
// Test fleet.Fmort and fleet.q |
|
| 58 | 3x |
std::vector<double> Fmort(nyears, 0); |
| 59 | 3x |
double q = fims_math::exp(fleet.log_q[0]); |
| 60 | 3x |
EXPECT_EQ(fleet.q[0], q); |
| 61 | 93x |
for (int i = 0; i < nyears; i++) |
| 62 |
{
|
|
| 63 | 90x |
Fmort[i] = fims_math::exp(fleet.log_Fmort[i]); |
| 64 | 90x |
EXPECT_EQ(fleet.Fmort[i], Fmort[i]); |
| 65 | ||
| 66 |
} |
|
| 67 | 3x |
EXPECT_EQ(fleet.Fmort.size(), nyears); |
| 68 |
} |
|
| 69 |
} // namespace |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/maturity/functors/logistic.hpp" |
|
| 3 | ||
| 4 |
namespace |
|
| 5 |
{
|
|
| 6 | ||
| 7 | ||
| 8 | 22x |
TEST(LogisticMaturity, CreateObject) |
| 9 |
{
|
|
| 10 | ||
| 11 | 3x |
fims_popdy::LogisticMaturity<double> maturity; |
| 12 | 3x |
maturity.inflection_point.resize(1); |
| 13 | 3x |
maturity.inflection_point[0] = 20.5; |
| 14 | 3x |
maturity.slope.resize(1); |
| 15 | 3x |
maturity.slope[0] = 0.15; |
| 16 | 3x |
double maturity_x = 40.5; |
| 17 |
// 1.0/(1.0+exp(-(40.5-20.5)*0.15)) = 0.9525741 |
|
| 18 | 3x |
double expect_maturity = 0.9525741; |
| 19 | 3x |
EXPECT_NEAR(maturity.evaluate(maturity_x), expect_maturity, 0.0001); |
| 20 | ||
| 21 | ||
| 22 |
} |
|
| 23 | ||
| 24 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "../../tests/gtest/test_population_test_fixture.hpp" |
|
| 3 | ||
| 4 |
namespace |
|
| 5 |
{
|
|
| 6 | ||
| 7 | 28x |
TEST_F(PopulationInitializeTestFixture, input_data_are_specified) |
| 8 |
{
|
|
| 9 | 3x |
EXPECT_EQ(population.id_g, id_g); |
| 10 | 3x |
EXPECT_EQ(population.nyears, nyears); |
| 11 | 3x |
EXPECT_EQ(population.nseasons, nseasons); |
| 12 | 3x |
EXPECT_EQ(population.nages, nages); |
| 13 | 3x |
EXPECT_EQ(population.fleets.size(), nfleets); |
| 14 |
} |
|
| 15 | ||
| 16 | 28x |
TEST_F(PopulationInitializeTestFixture, Initialize_works) |
| 17 |
{
|
|
| 18 | ||
| 19 | 3x |
population.numbers_at_age.resize((nyears + 1) * nages); |
| 20 | 3x |
population.Initialize(nyears, nseasons, nages); |
| 21 | ||
| 22 | 3x |
EXPECT_EQ(population.nfleets, nfleets); |
| 23 | 3x |
EXPECT_EQ(population.ages.size(), nages); |
| 24 | 3x |
EXPECT_EQ(population.mortality_F.size(), nyears * nages); |
| 25 | 3x |
EXPECT_EQ(population.mortality_Z.size(), nyears * nages); |
| 26 | 3x |
EXPECT_EQ(population.proportion_mature_at_age.size(), (nyears+1) * nages); |
| 27 | 3x |
EXPECT_EQ(population.weight_at_age.size(), nages); |
| 28 | 3x |
EXPECT_EQ(population.unfished_numbers_at_age.size(), (nyears + 1) * nages); |
| 29 | 3x |
EXPECT_EQ(population.numbers_at_age.size(), (nyears + 1) * nages); |
| 30 | 3x |
EXPECT_EQ(population.expected_catch.size(), nyears * nfleets); |
| 31 | 3x |
EXPECT_EQ(population.biomass.size(), (nyears + 1)); |
| 32 | 3x |
EXPECT_EQ(population.unfished_spawning_biomass.size(), (nyears + 1)); |
| 33 | 3x |
EXPECT_EQ(population.spawning_biomass.size(), nyears + 1); |
| 34 | 3x |
EXPECT_EQ(population.log_init_naa.size(), nages); |
| 35 | 3x |
EXPECT_EQ(population.proportion_female.size(), nages); |
| 36 | 3x |
EXPECT_EQ(population.log_M.size(), nyears * nages); |
| 37 | 3x |
EXPECT_EQ(population.M.size(), nyears * nages); |
| 38 |
} |
|
| 39 | ||
| 40 | 28x |
TEST_F(PopulationPrepareTestFixture, Prepare_works) |
| 41 |
{
|
|
| 42 |
|
|
| 43 | 3x |
EXPECT_EQ( |
| 44 |
population.unfished_spawning_biomass, |
|
| 45 |
fims::Vector<double>(nyears + 1, 0) // vector size type = 1 and vector value = 0 |
|
| 46 |
); |
|
| 47 | ||
| 48 | 96x |
for (int i = 0; i < population.spawning_biomass.size(); i++) |
| 49 |
{
|
|
| 50 | 93x |
EXPECT_EQ( |
| 51 |
population.spawning_biomass, |
|
| 52 |
fims::Vector<double>(nyears + 1, 0) // vector size type = 1 and vector value = 0) |
|
| 53 |
); |
|
| 54 |
}; |
|
| 55 | ||
| 56 | 1083x |
for (int i = 0; i < population.mortality_F.size(); i++) |
| 57 |
{
|
|
| 58 | 1080x |
EXPECT_EQ( |
| 59 |
population.mortality_F, |
|
| 60 |
fims::Vector<double>(nyears * nages, 0) // vector size type = 1 and vector value = 0) |
|
| 61 |
); |
|
| 62 |
}; |
|
| 63 | ||
| 64 | 183x |
for (int i = 0; i < population.expected_catch.size(); i++) |
| 65 |
{
|
|
| 66 | 180x |
EXPECT_EQ( |
| 67 |
population.expected_catch, |
|
| 68 |
fims::Vector<double>(nyears * nfleets, 0) |
|
| 69 |
); |
|
| 70 |
}; |
|
| 71 | ||
| 72 |
// Test population.naa |
|
| 73 | 3x |
fims::Vector<double> naa(nages, 0); |
| 74 | 39x |
for (int i = 0; i < nages; i++) |
| 75 |
{
|
|
| 76 | 36x |
naa[i] = fims_math::exp(population.log_init_naa[i]); |
| 77 |
} |
|
| 78 | ||
| 79 |
// Test population.M |
|
| 80 | 3x |
fims::Vector<double> M(nyears * nages, 0); |
| 81 | 1083x |
for (int i = 0; i < nyears * nages; i++) |
| 82 |
{
|
|
| 83 | 1080x |
M[i] = fims_math::exp(population.log_M[i]); |
| 84 | 1080x |
EXPECT_EQ(population.M[i], M[i]); |
| 85 |
} |
|
| 86 | 3x |
EXPECT_EQ(population.M.size(), nyears * nages); |
| 87 | ||
| 88 |
// Test population.proportion_female |
|
| 89 | 3x |
fims::Vector<double> p_female(nages, 0.5); |
| 90 | 39x |
for(int i = 0; i < nages; i++) |
| 91 |
{
|
|
| 92 | 36x |
EXPECT_EQ(population.proportion_female[i], p_female[i]); |
| 93 |
} |
|
| 94 | ||
| 95 |
// Test population.fleet->Fmort |
|
| 96 |
// fmort and logfmort are vectors of length year |
|
| 97 | 3x |
fims::Vector<double> Fmort(nfleets * nyears, 0); |
| 98 | 9x |
for(size_t i = 0; i < nfleets; i++){
|
| 99 | 186x |
for(size_t y = 0; y < nyears; y++){
|
| 100 | 180x |
size_t index_yf = y * population.nfleets + i; |
| 101 | 180x |
Fmort[index_yf] = fims_math::exp(population.fleets[i]->log_Fmort[y]); |
| 102 | 180x |
EXPECT_EQ(population.fleets[i]->Fmort[y], Fmort[index_yf]); |
| 103 |
} |
|
| 104 | 6x |
EXPECT_EQ(population.fleets[i]->Fmort.size(), nyears); |
| 105 |
} |
|
| 106 |
|
|
| 107 |
} |
|
| 108 |
} // namespace |
|
| 109 |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/recruitment/functors/recruitment_base.hpp" |
|
| 3 |
#include "population_dynamics/recruitment/functors/sr_beverton_holt.hpp" |
|
| 4 | ||
| 5 |
namespace |
|
| 6 |
{
|
|
| 7 | 22x |
TEST(RecruitmentDeviations, ConstraintWorks) |
| 8 |
{
|
|
| 9 | 3x |
fims_popdy::SRBevertonHolt<double> recruit; |
| 10 | 3x |
recruit.log_recruit_devs.resize(3); |
| 11 | 3x |
recruit.log_recruit_devs[0] = -1.0; |
| 12 | 3x |
recruit.log_recruit_devs[1] = 2.0; |
| 13 | 3x |
recruit.log_recruit_devs[2] = 3.0; |
| 14 | ||
| 15 |
// Test if constrain_deviations = false works |
|
| 16 | 3x |
recruit.constrain_deviations = false; |
| 17 | 3x |
recruit.PrepareConstrainedDeviations(); |
| 18 | ||
| 19 | 3x |
fims::Vector<double> expected_deviations_false(3, 0); |
| 20 | 3x |
expected_deviations_false[0] = -1.0; |
| 21 | 3x |
expected_deviations_false[1] = 2.0; |
| 22 | 3x |
expected_deviations_false[2] = 3.0; |
| 23 | 12x |
for (int i = 0; i < recruit.log_recruit_devs.size(); i++) |
| 24 |
{
|
|
| 25 | 9x |
EXPECT_EQ(recruit.log_recruit_devs[i], |
| 26 |
expected_deviations_false[i]); |
|
| 27 |
} |
|
| 28 | ||
| 29 |
// Test if constrain_deviations = true works |
|
| 30 | 3x |
recruit.constrain_deviations = true; |
| 31 | 3x |
recruit.PrepareConstrainedDeviations(); |
| 32 |
// c(-1.0, 2.0, 3.0)-sum(c(-1.0, 2.0, 3.0))/3 = -2.3333333 0.6666667 1.6666667 |
|
| 33 | 3x |
std::vector<double> expected_deviations_true = {-2.3333333, 0.6666667, 1.6666667};
|
| 34 | ||
| 35 | 12x |
for (int i = 0; i < recruit.log_recruit_devs.size(); i++) |
| 36 |
{
|
|
| 37 | 9x |
EXPECT_NEAR(recruit.log_recruit_devs[i], |
| 38 |
expected_deviations_true[i], 0.0000001); |
|
| 39 |
} |
|
| 40 |
} |
|
| 41 | ||
| 42 |
} |
| 1 |
/** |
|
| 2 |
* @file logistic.hpp |
|
| 3 |
* @brief Declares the DoubleLogisticSelectivity class which implements the |
|
| 4 |
* logistic function from fims_math in the selectivity module. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef POPULATION_DYNAMICS_SELECTIVITY_DOUBLE_LOGISTIC_HPP |
|
| 10 |
#define POPULATION_DYNAMICS_SELECTIVITY_DOUBLE_LOGISTIC_HPP |
|
| 11 | ||
| 12 |
//#include "../../../interface/interface.hpp" |
|
| 13 |
#include "../../../common/fims_math.hpp" |
|
| 14 |
#include "../../../common/fims_vector.hpp" |
|
| 15 |
#include "selectivity_base.hpp" |
|
| 16 | ||
| 17 |
namespace fims_popdy {
|
|
| 18 | ||
| 19 |
/** |
|
| 20 |
* @brief DoubleLogisticSelectivity class that returns the double logistic |
|
| 21 |
* function value from fims_math. |
|
| 22 |
*/ |
|
| 23 |
template <typename Type> |
|
| 24 |
struct DoubleLogisticSelectivity : public SelectivityBase<Type> {
|
|
| 25 |
fims::Vector<Type> inflection_point_asc; /**< 50% quantile of the value of the quantity of |
|
| 26 |
interest (x) on the ascending limb of the double logistic curve; |
|
| 27 |
e.g. age at which 50% of the fish are selected */ |
|
| 28 |
fims::Vector<Type> slope_asc; /**<scalar multiplier of difference between quantity of |
|
| 29 |
interest value (x) and inflection_point on the ascending limb of |
|
| 30 |
the double logistic curve*/ |
|
| 31 |
fims::Vector<Type> inflection_point_desc; /**< 50% quantile of the value of the quantity of |
|
| 32 |
interest (x) on the descending limb of the double logistic curve; |
|
| 33 |
e.g. age at which 50% of the fish are selected */ |
|
| 34 |
fims::Vector<Type> slope_desc; /**<scalar multiplier of difference between quantity of |
|
| 35 |
interest value (x) and inflection_point on the descending limb of |
|
| 36 |
the double logistic curve */ |
|
| 37 | ||
| 38 | 9x |
DoubleLogisticSelectivity() : SelectivityBase<Type>() |
| 39 |
{
|
|
| 40 |
} |
|
| 41 | ||
| 42 | 6x |
virtual ~DoubleLogisticSelectivity() |
| 43 |
{
|
|
| 44 |
} |
|
| 45 | ||
| 46 |
/** |
|
| 47 |
* @brief Method of the double logistic selectivity class that implements the |
|
| 48 |
* double logistic function from FIMS math. |
|
| 49 |
* |
|
| 50 |
* \f$ \frac{1.0}{ 1.0 + exp(-1.0 * slope\_asc (x - inflection_point\_asc))}
|
|
| 51 |
* \left(1.0-\frac{1.0}{ 1.0 + exp(-1.0 * slope\_desc (x -
|
|
| 52 |
* inflection_point\_desc))} \right)\f$ |
|
| 53 |
* |
|
| 54 |
* @param x The independent variable in the double logistic function (e.g., |
|
| 55 |
* age or size in selectivity). |
|
| 56 |
*/ |
|
| 57 | 3x |
virtual const Type evaluate(const Type &x) |
| 58 |
{
|
|
| 59 | 3x |
return fims_math::double_logistic<Type>( |
| 60 | 3x |
inflection_point_asc[0], slope_asc[0], inflection_point_desc[0], slope_desc[0], x); |
| 61 |
} |
|
| 62 | ||
| 63 |
/** |
|
| 64 |
* @brief Method of the double logistic selectivity class that implements the |
|
| 65 |
* double logistic function from FIMS math. |
|
| 66 |
* |
|
| 67 |
* \f$ \frac{1.0}{ 1.0 + exp(-1.0 * slope\_asc_t (x - inflection_point\_asc_t))}
|
|
| 68 |
* \left(1.0-\frac{1.0}{ 1.0 + exp(-1.0 * slope\_desc_t (x -
|
|
| 69 |
* inflection_point\_desc_t))} \right)\f$ |
|
| 70 |
* |
|
| 71 |
* @param x The independent variable in the double logistic function (e.g., |
|
| 72 |
* age or size in selectivity). |
|
| 73 |
* @param pos Position index, e.g., which year. |
|
| 74 |
*/ |
|
| 75 | ! |
virtual const Type evaluate(const Type &x, size_t pos) |
| 76 |
{
|
|
| 77 | ! |
return fims_math::double_logistic<Type>( |
| 78 | ! |
inflection_point_asc.get_force_scalar(pos), slope_asc.get_force_scalar(pos), |
| 79 | ! |
inflection_point_desc.get_force_scalar(pos), slope_desc.get_force_scalar(pos), x); |
| 80 |
} |
|
| 81 |
}; |
|
| 82 | ||
| 83 |
} // namespace fims_popdy |
|
| 84 | ||
| 85 |
#endif /* POPULATION_DYNAMICS_SELECTIVITY_DOUBLE_LOGISTIC_HPP */ |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/selectivity/functors/double_logistic.hpp" |
|
| 3 | ||
| 4 |
namespace |
|
| 5 |
{
|
|
| 6 | ||
| 7 | 22x |
TEST(DoubleLogisticSelectivity, CreateObject) |
| 8 |
{
|
|
| 9 |
|
|
| 10 | 3x |
fims_popdy::DoubleLogisticSelectivity<double> fishery_selectivity; |
| 11 | 3x |
fishery_selectivity.inflection_point_asc.resize(1); |
| 12 | 3x |
fishery_selectivity.slope_asc.resize(1); |
| 13 | 3x |
fishery_selectivity.inflection_point_desc.resize(1); |
| 14 | 3x |
fishery_selectivity.slope_desc.resize(1); |
| 15 | 3x |
fishery_selectivity.inflection_point_asc[0] = 10.5; |
| 16 | 3x |
fishery_selectivity.slope_asc[0] = 0.2; |
| 17 | 3x |
fishery_selectivity.inflection_point_desc[0] = 15.0; |
| 18 | 3x |
fishery_selectivity.slope_desc[0] = 0.05; |
| 19 | 3x |
double fishery_x = 34.5; |
| 20 |
// 1.0/(1.0+exp(-(34.5-10.5)*0.2)) * (1.0 - 1.0/(1.0+exp(-(34.5-15.0)*0.05))) = 0.2716494 |
|
| 21 | 3x |
double expect_fishery = 0.2716494; |
| 22 | 3x |
EXPECT_NEAR(fishery_selectivity.evaluate(fishery_x), expect_fishery, 0.0001); |
| 23 | ||
| 24 |
} |
|
| 25 | ||
| 26 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/selectivity/functors/logistic.hpp" |
|
| 3 | ||
| 4 |
namespace |
|
| 5 |
{
|
|
| 6 | ||
| 7 |
|
|
| 8 | 22x |
TEST(LogisticSelectivity, CreateObject) |
| 9 |
{
|
|
| 10 |
|
|
| 11 | 3x |
fims_popdy::LogisticSelectivity<double> fishery_selectivity; |
| 12 | 3x |
fishery_selectivity.inflection_point.resize(1); |
| 13 | 3x |
fishery_selectivity.slope.resize(1); |
| 14 | 3x |
fishery_selectivity.inflection_point[0] = 20.5; |
| 15 | 3x |
fishery_selectivity.slope[0] = 0.2; |
| 16 | 3x |
double fishery_x = 40.5; |
| 17 |
// 1.0/(1.0+exp(-(40.5-20.5)*0.2)) = 0.9820138 |
|
| 18 | 3x |
double expect_fishery = 0.9820138; |
| 19 | 3x |
EXPECT_NEAR(fishery_selectivity.evaluate(fishery_x), expect_fishery, 0.0001); |
| 20 | ||
| 21 | ||
| 22 |
} |
|
| 23 | ||
| 24 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/population/population.hpp" |
|
| 3 |
#include "../../tests/gtest/test_population_test_fixture.hpp" |
|
| 4 | ||
| 5 |
namespace |
|
| 6 |
{
|
|
| 7 | ||
| 8 | 22x |
TEST_F(PopulationEvaluateTestFixture, CalculateIndex_works) |
| 9 |
{
|
|
| 10 |
|
|
| 11 | 3x |
std::vector<double> expected_index(nyears * nfleets, 0); |
| 12 |
|
|
| 13 |
// calculate index numbers at age in population module |
|
| 14 | 3x |
population.CalculateIndex(i_age_year, year, age); |
| 15 |
|
|
| 16 |
// The test checks a single age in a single year, not an index. |
|
| 17 |
// It was developed to test CalculateIndex() function while |
|
| 18 |
// the integration test loops over all ages to test the index. |
|
| 19 | 9x |
for (int fleet_ = 0; fleet_ < population.nfleets; fleet_++) |
| 20 |
{
|
|
| 21 | 6x |
if(population.fleets[fleet_]->is_survey){
|
| 22 | 3x |
int index_yf = year * population.nfleets + fleet_; |
| 23 |
|
|
| 24 |
// Currently q is not a vector and not changing over years. |
|
| 25 |
// When testing time varying q, better to test entire vector. |
|
| 26 |
// If not possible to test entire vector, test middle or second to last |
|
| 27 |
// than earlier years (collapses to mean in early years) |
|
| 28 | 9x |
expected_index[index_yf] += population.numbers_at_age[i_age_year]* |
| 29 | 3x |
population.fleets[fleet_]->q[0]* |
| 30 | 3x |
population.fleets[fleet_]->selectivity->evaluate(population.ages[age])* |
| 31 | 3x |
population.growth->evaluate(population.ages[age]); |
| 32 |
|
|
| 33 | 3x |
EXPECT_GT(population.fleets[fleet_]->expected_index[year], 0); |
| 34 | 3x |
EXPECT_GT(expected_index[index_yf], 0); |
| 35 | 3x |
EXPECT_EQ(expected_index[index_yf], population.fleets[fleet_]->expected_index[year]); |
| 36 |
} |
|
| 37 |
} |
|
| 38 |
} |
|
| 39 |
} |
| 1 |
/** |
|
| 2 |
* @file fims_json.hpp |
|
| 3 |
* @brief A simple JSON parsing and generation library. |
|
| 4 |
* @details This library provides classes and functions for parsing JSON |
|
| 5 |
* strings and generating JSON data structures. |
|
| 6 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 7 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 8 |
* folder for reuse information. |
|
| 9 |
*/ |
|
| 10 |
#include <cctype> |
|
| 11 |
#include <iostream> |
|
| 12 |
#include <map> |
|
| 13 |
#include <sstream> |
|
| 14 |
#include <string> |
|
| 15 |
#include <algorithm> |
|
| 16 |
#include <vector> |
|
| 17 | ||
| 18 | ||
| 19 |
namespace fims {
|
|
| 20 |
class JsonValue; |
|
| 21 | ||
| 22 |
/** |
|
| 23 |
* Alias for a JSON object, mapping strings to JSON values. |
|
| 24 |
*/ |
|
| 25 |
using JsonObject = std::map<std::string, JsonValue>; |
|
| 26 | ||
| 27 |
/** |
|
| 28 |
* Alias for a JSON array, containing a sequence of JSON values. |
|
| 29 |
*/ |
|
| 30 |
using JsonArray = std::vector<JsonValue>; |
|
| 31 | ||
| 32 |
/** |
|
| 33 |
* Represents different types of JSON values. |
|
| 34 |
*/ |
|
| 35 |
enum JsonValueType {
|
|
| 36 |
Null = 0, /**< Null JSON value. */ |
|
| 37 |
Number, /**< Numeric JSON value. */ |
|
| 38 |
String, /**< String JSON value. */ |
|
| 39 |
Bool, /**< Boolean JSON value. */ |
|
| 40 |
Object, /**< JSON object. */ |
|
| 41 |
JArray /**< JSON array. */ |
|
| 42 |
}; |
|
| 43 | ||
| 44 |
/** |
|
| 45 |
* Represents a JSON value. |
|
| 46 |
*/ |
|
| 47 | 1264156x |
class JsonValue {
|
| 48 |
public: |
|
| 49 | ||
| 50 |
/** Default constructor, initializes to Null value. */ |
|
| 51 | 824x |
JsonValue() : type(JsonValueType::Null) {
|
| 52 |
} |
|
| 53 | ||
| 54 |
/** Constructor for numeric JSON value (i.e., integer). */ |
|
| 55 | 33044x |
JsonValue(int num) : type(JsonValueType::Number), number(num) {
|
| 56 |
} |
|
| 57 | ||
| 58 |
/** Constructor for numeric JSON value (i.e., double). */ |
|
| 59 | 177940x |
JsonValue(double num) : type(JsonValueType::Number), number(num) {
|
| 60 |
} |
|
| 61 | ||
| 62 |
/** Constructor for string JSON value. */ |
|
| 63 | 808x |
JsonValue(const std::string& str) : type(JsonValueType::String), str(str) {
|
| 64 |
} |
|
| 65 | ||
| 66 |
/** Constructor for boolean JSON value. */ |
|
| 67 | 16x |
JsonValue(bool b) : type(JsonValueType::Bool), boolean(b) {
|
| 68 |
} |
|
| 69 | ||
| 70 |
/** Constructor for JSON object value. */ |
|
| 71 | 160x |
JsonValue(const JsonObject& obj) : type(JsonValueType::Object), object(obj) {
|
| 72 |
} |
|
| 73 | ||
| 74 |
/** Constructor for JSON array value. */ |
|
| 75 | 1624x |
JsonValue(const JsonArray& arr) : type(JsonValueType::JArray), array(arr) {
|
| 76 |
} |
|
| 77 | ||
| 78 |
/** Get the type of the JSON value. */ |
|
| 79 | 105076x |
JsonValueType GetType() const {
|
| 80 | 105076x |
return type; |
| 81 |
} |
|
| 82 | ||
| 83 |
/** Get the numeric value as an integer. */ |
|
| 84 | 24x |
int GetInt() const {
|
| 85 | 24x |
return static_cast<int> (number); |
| 86 |
} |
|
| 87 | ||
| 88 |
/** Get the numeric value as a double. */ |
|
| 89 | 109532x |
double GetDouble() const {
|
| 90 | 109532x |
return number; |
| 91 |
} |
|
| 92 | ||
| 93 |
/** Get the string value. */ |
|
| 94 | 404x |
const std::string& GetString() const {
|
| 95 | 404x |
return str; |
| 96 |
} |
|
| 97 | ||
| 98 |
/** Get the boolean value. */ |
|
| 99 | 8x |
bool GetBool() const {
|
| 100 | 8x |
return boolean; |
| 101 |
} |
|
| 102 | ||
| 103 |
/** Get the JSON object. */ |
|
| 104 | 128x |
JsonObject& GetObject() {
|
| 105 | 128x |
return object; |
| 106 |
} |
|
| 107 | ||
| 108 |
/** Get the JSON array. */ |
|
| 109 | 3820x |
JsonArray& GetArray() {
|
| 110 | 3820x |
return array; |
| 111 |
} |
|
| 112 | ||
| 113 |
private: |
|
| 114 |
JsonValueType type; /**< Type of the JSON value. */ |
|
| 115 |
double number; /**< Numeric value. */ |
|
| 116 |
std::string str; /**< String value. */ |
|
| 117 |
bool boolean; /**< Boolean value. */ |
|
| 118 |
JsonObject object; /**< JSON object. */ |
|
| 119 |
JsonArray array; /**< JSON array. */ |
|
| 120 |
}; |
|
| 121 | ||
| 122 |
/** |
|
| 123 |
* Parses JSON strings and generates JSON values. |
|
| 124 |
*/ |
|
| 125 |
class JsonParser {
|
|
| 126 |
public: |
|
| 127 |
/** Parse a JSON string and return the corresponding JSON value. */ |
|
| 128 |
JsonValue Parse(const std::string& json); |
|
| 129 |
/** Write a JSON value to a file. */ |
|
| 130 |
void WriteToFile(const std::string& filename, JsonValue jsonValue); |
|
| 131 |
/** Display a JSON value to the standard output. */ |
|
| 132 |
void Show(JsonValue jsonValue); |
|
| 133 | ||
| 134 |
/** Remove whitespace in JSON. */ |
|
| 135 | ! |
static std::string removeWhitespace(const std::string& input) {
|
| 136 | ! |
std::string result = input; |
| 137 | ! |
result.erase(std::remove_if(result.begin(), result.end(), ::isspace), result.end()); |
| 138 | ! |
return result; |
| 139 |
} |
|
| 140 | ||
| 141 |
/** |
|
| 142 |
* @brief Formats a JSON string. |
|
| 143 |
* @param json |
|
| 144 |
* @return |
|
| 145 |
*/ |
|
| 146 | ! |
static std::string PrettyFormatJSON(const std::string& json) {
|
| 147 | ! |
std::string result; |
| 148 | ! |
std::string input = JsonParser::removeWhitespace(json); |
| 149 | ! |
int indentLevel = 0; |
| 150 | ! |
bool inQuotes = false; |
| 151 | ||
| 152 | ! |
for (size_t i = 0; i < input.size(); ++i) {
|
| 153 | ! |
char current = input[i]; |
| 154 | ||
| 155 | ! |
switch (current) {
|
| 156 |
case '{':
|
|
| 157 |
case '[': |
|
| 158 | ! |
result += current; |
| 159 | ! |
if (!inQuotes) {
|
| 160 | ! |
result += '\n'; |
| 161 | ! |
indentLevel++; |
| 162 | ! |
result += std::string(indentLevel * 4, ' '); |
| 163 |
} |
|
| 164 | ! |
break; |
| 165 | ||
| 166 |
case '}': |
|
| 167 |
case ']': |
|
| 168 | ! |
if (!inQuotes) {
|
| 169 | ! |
result += '\n'; |
| 170 | ! |
indentLevel--; |
| 171 | ! |
result += std::string(indentLevel * 4, ' '); |
| 172 |
} |
|
| 173 | ! |
result += current; |
| 174 | ! |
break; |
| 175 | ||
| 176 |
case ',': |
|
| 177 | ! |
result += current; |
| 178 | ! |
if (!inQuotes) {
|
| 179 | ! |
result += '\n'; |
| 180 | ! |
result += std::string(indentLevel * 4, ' '); |
| 181 |
} |
|
| 182 | ! |
break; |
| 183 | ||
| 184 |
case ':': |
|
| 185 | ! |
result += current; |
| 186 | ! |
if (!inQuotes) result += " "; |
| 187 | ! |
break; |
| 188 | ||
| 189 |
case '"': |
|
| 190 | ! |
result += current; |
| 191 |
// Toggle inQuotes when we encounter a double-quote |
|
| 192 | ! |
if (i == 0 || input[i - 1] != '\\') {
|
| 193 | ! |
inQuotes = !inQuotes; |
| 194 |
} |
|
| 195 | ! |
break; |
| 196 | ||
| 197 |
default: |
|
| 198 | ! |
result += current; |
| 199 | ! |
break; |
| 200 |
} |
|
| 201 |
} |
|
| 202 | ! |
return result; |
| 203 |
} |
|
| 204 | ||
| 205 |
private: |
|
| 206 |
/** Skip whitespace characters in the input string. */ |
|
| 207 |
void SkipWhitespace(); |
|
| 208 |
/** Parse a JSON value. */ |
|
| 209 |
JsonValue ParseValue(); |
|
| 210 |
/** Parse a numeric JSON value. */ |
|
| 211 |
JsonValue ParseNumber(); |
|
| 212 |
/** Parse a string JSON value. */ |
|
| 213 |
JsonValue ParseString(); |
|
| 214 |
/** Parse a boolean JSON value. */ |
|
| 215 |
JsonValue ParseBool(); |
|
| 216 |
/** Parse a null JSON value. */ |
|
| 217 |
JsonValue ParseNull(); |
|
| 218 |
/** Parse a JSON object. */ |
|
| 219 |
JsonValue ParseObject(); |
|
| 220 |
/** Parse a JSON array. */ |
|
| 221 |
JsonValue ParseArray(); |
|
| 222 |
/** Write a JSON value to an output file stream. */ |
|
| 223 |
void WriteJsonValue(std::ofstream& outputFile, JsonValue jsonValue); |
|
| 224 |
/** Display a JSON value to an output stream. */ |
|
| 225 |
void PrintJsonValue(std::ostream& outputFile, JsonValue jsonValue); |
|
| 226 |
/** Indentation helper for printing JSON values in an output file stream. */ |
|
| 227 |
void Indent(std::ostream& outputFile, int level); |
|
| 228 |
/** Indentation helper for printing JSON values in an output stream. */ |
|
| 229 |
void Indent(std::ofstream& outputFile, int level); |
|
| 230 | ||
| 231 |
std::string data; /**< Input JSON data. */ |
|
| 232 |
size_t position; /**< Current position in the data. */ |
|
| 233 |
}; |
|
| 234 | ||
| 235 |
/** |
|
| 236 |
* Parse a JSON string and return the corresponding JSON value. |
|
| 237 |
* @param json The JSON string to parse. |
|
| 238 |
* @return The parsed JSON value. |
|
| 239 |
*/ |
|
| 240 | 8x |
JsonValue JsonParser::Parse(const std::string& json) {
|
| 241 | 8x |
data = json; |
| 242 | 8x |
position = 0; |
| 243 | 8x |
return ParseValue(); |
| 244 |
} |
|
| 245 | ||
| 246 |
/** |
|
| 247 |
* @brief Skip the white space. |
|
| 248 |
* |
|
| 249 |
*/ |
|
| 250 | 315240x |
void JsonParser::SkipWhitespace() {
|
| 251 | 423664x |
while (position < data.size() && std::isspace(data[position])) {
|
| 252 | 108424x |
position++; |
| 253 |
} |
|
| 254 |
} |
|
| 255 | ||
| 256 |
/** |
|
| 257 |
* Parse a JSON value. |
|
| 258 |
* @return The parsed JSON value. |
|
| 259 |
*/ |
|
| 260 | 104952x |
JsonValue JsonParser::ParseValue() {
|
| 261 |
/** Skip whitespace characters in the input string. */ |
|
| 262 | 104952x |
SkipWhitespace(); |
| 263 | 104952x |
char current = data[position]; |
| 264 | 104952x |
if (current == '{') {
|
| 265 | 80x |
return ParseObject(); |
| 266 | 104872x |
} else if (current == '[') {
|
| 267 | 808x |
return ParseArray(); |
| 268 | 104064x |
} else if (current == '"') {
|
| 269 | 4x |
return ParseString(); |
| 270 | 104060x |
} else if (current == 't' || current == 'f') {
|
| 271 | 8x |
return ParseBool(); |
| 272 | 104052x |
} else if (current == 'n') {
|
| 273 | ! |
return ParseNull(); |
| 274 |
} else {
|
|
| 275 | 104052x |
return ParseNumber(); |
| 276 |
} |
|
| 277 |
} |
|
| 278 | ||
| 279 |
/** |
|
| 280 |
* Parse a numeric JSON value. |
|
| 281 |
* @return The parsed JSON value. |
|
| 282 |
*/ |
|
| 283 | 104052x |
JsonValue JsonParser::ParseNumber() {
|
| 284 | 104052x |
size_t end_pos = position; |
| 285 | 104052x |
bool is_float = false; |
| 286 | 1529496x |
while (end_pos < data.size() && |
| 287 | 764748x |
(std::isdigit(data[end_pos]) || data[end_pos] == '.' || |
| 288 | 178874x |
data[end_pos] == '-' || data[end_pos] == 'e' || |
| 289 | 104052x |
data[end_pos] == 'E')) {
|
| 290 | 660696x |
if (data[end_pos] == '.' || data[end_pos] == 'e' || data[end_pos] == 'E') {
|
| 291 | 112446x |
is_float = true; |
| 292 |
} |
|
| 293 | 660696x |
end_pos++; |
| 294 |
} |
|
| 295 | ||
| 296 | 104052x |
std::string num_str = data.substr(position, end_pos - position); |
| 297 | 104052x |
position = end_pos; |
| 298 | ||
| 299 | 104052x |
if (is_float) {
|
| 300 |
double num; |
|
| 301 | 87530x |
std::istringstream(num_str) >> num; |
| 302 | 87530x |
return JsonValue(num); |
| 303 |
} else {
|
|
| 304 |
int num; |
|
| 305 | 16522x |
std::istringstream(num_str) >> num; |
| 306 | 16522x |
return JsonValue(num); |
| 307 |
} |
|
| 308 |
} |
|
| 309 | ||
| 310 |
/** |
|
| 311 |
* Parse a string JSON value. |
|
| 312 |
* @return The parsed JSON value. |
|
| 313 |
*/ |
|
| 314 | 404x |
JsonValue JsonParser::ParseString() {
|
| 315 | 404x |
position++; // Skip the initial '"' |
| 316 | 404x |
size_t end_pos = data.find('"', position);
|
| 317 | 404x |
std::string str = data.substr(position, end_pos - position); |
| 318 | 404x |
position = end_pos + 1; |
| 319 | 404x |
return JsonValue(str); |
| 320 |
} |
|
| 321 | ||
| 322 |
/** |
|
| 323 |
* Parse a boolean JSON value. |
|
| 324 |
* @return The parsed JSON value. |
|
| 325 |
*/ |
|
| 326 | 8x |
JsonValue JsonParser::ParseBool() {
|
| 327 | 8x |
if (data.compare(position, 4, "true") == 0) {
|
| 328 | 4x |
position += 4; |
| 329 | 4x |
return JsonValue(true); |
| 330 | 4x |
} else if (data.compare(position, 5, "false") == 0) {
|
| 331 | 4x |
position += 5; |
| 332 | 4x |
return JsonValue(false); |
| 333 |
} else {
|
|
| 334 |
// Invalid boolean value |
|
| 335 | ! |
return JsonValue(); |
| 336 |
} |
|
| 337 |
} |
|
| 338 | ||
| 339 |
/** |
|
| 340 |
* Parse a null JSON value. |
|
| 341 |
* @return The parsed JSON value. |
|
| 342 |
*/ |
|
| 343 | ! |
JsonValue JsonParser::ParseNull() {
|
| 344 | ! |
if (data.compare(position, 4, "null") == 0) {
|
| 345 | ! |
position += 4; |
| 346 | ! |
return JsonValue(); |
| 347 |
} else {
|
|
| 348 |
// Invalid null value |
|
| 349 | ! |
return JsonValue(); |
| 350 |
} |
|
| 351 |
} |
|
| 352 | ||
| 353 |
/** |
|
| 354 |
* Parse a JSON object. |
|
| 355 |
* @return The parsed JSON value representing the object. |
|
| 356 |
*/ |
|
| 357 | 80x |
JsonValue JsonParser::ParseObject() {
|
| 358 | 80x |
JsonObject obj; |
| 359 | 80x |
position++; // Skip the initial '{'
|
| 360 | ||
| 361 | 480x |
while (data[position] != '}') {
|
| 362 | 400x |
SkipWhitespace(); |
| 363 | 400x |
std::string key = ParseString().GetString(); |
| 364 | ||
| 365 | 400x |
position++; // Skip the ':' |
| 366 | 400x |
SkipWhitespace(); |
| 367 | 400x |
JsonValue value = ParseValue(); |
| 368 | 400x |
obj[key] = value; |
| 369 | ||
| 370 | 400x |
SkipWhitespace(); |
| 371 | 400x |
if (data[position] == ',') {
|
| 372 | 320x |
position++; |
| 373 |
} |
|
| 374 |
} |
|
| 375 | ||
| 376 | 80x |
position++; // Skip the trailing '}' |
| 377 | 80x |
return JsonValue(obj); |
| 378 |
} |
|
| 379 | ||
| 380 |
/** |
|
| 381 |
* Parse a JSON array. |
|
| 382 |
* @return The parsed JSON value representing the array. |
|
| 383 |
*/ |
|
| 384 | 808x |
JsonValue JsonParser::ParseArray() {
|
| 385 | 808x |
JsonArray arr; |
| 386 | 808x |
position++; // Skip the initial '[' |
| 387 | ||
| 388 | 105352x |
while (data[position] != ']') {
|
| 389 | 104544x |
SkipWhitespace(); |
| 390 | 104544x |
JsonValue value = ParseValue(); |
| 391 | 104544x |
arr.push_back(value); |
| 392 | ||
| 393 | 104544x |
SkipWhitespace(); |
| 394 | 104544x |
if (data[position] == ',') {
|
| 395 | 103736x |
position++; |
| 396 |
} |
|
| 397 |
} |
|
| 398 | ||
| 399 | 808x |
position++; // Skip the trailing ']' |
| 400 | 808x |
return JsonValue(arr); |
| 401 |
} |
|
| 402 | ||
| 403 |
/** |
|
| 404 |
* Write a JSON value to an output file. |
|
| 405 |
* @param filename The name of the output file. |
|
| 406 |
* @param jsonValue The JSON value to write. |
|
| 407 |
*/ |
|
| 408 | 8x |
void JsonParser::WriteToFile(const std::string& filename, JsonValue jsonValue) {
|
| 409 | 8x |
std::ofstream outputFile(filename); |
| 410 | 8x |
if (!outputFile) {
|
| 411 | ! |
std::cerr << "Error: Unable to open file " << filename << " for writing." |
| 412 | ! |
<< std::endl; |
| 413 | ! |
return; |
| 414 |
} |
|
| 415 | ||
| 416 |
/** Call a private helper function to write JSON values recursively */ |
|
| 417 | 8x |
WriteJsonValue(outputFile, jsonValue); |
| 418 |
} |
|
| 419 | ||
| 420 |
/** |
|
| 421 |
* Write a JSON value to an output file. |
|
| 422 |
* Private helper function to write JSON values recursively |
|
| 423 |
* @param outputFile The output file stream. |
|
| 424 |
* @param jsonValue The JSON value to write. |
|
| 425 |
*/ |
|
| 426 | 104952x |
void JsonParser::WriteJsonValue(std::ofstream& outputFile, |
| 427 |
JsonValue jsonValue) {
|
|
| 428 | 104952x |
switch (jsonValue.GetType()) {
|
| 429 |
case JsonValueType::Null: |
|
| 430 | ! |
outputFile << "null"; |
| 431 | ! |
break; |
| 432 |
case JsonValueType::Number: |
|
| 433 | 104052x |
outputFile << jsonValue.GetDouble(); |
| 434 | 104052x |
break; |
| 435 |
case JsonValueType::String: |
|
| 436 | 4x |
outputFile << "\"" << jsonValue.GetString() << "\""; |
| 437 | 4x |
break; |
| 438 |
case JsonValueType::Bool: |
|
| 439 | 8x |
outputFile << (jsonValue.GetBool() ? "true" : "false"); |
| 440 | 8x |
break; |
| 441 |
case JsonValueType::Object: |
|
| 442 |
{
|
|
| 443 | 80x |
JsonObject& obj = jsonValue.GetObject(); |
| 444 | 80x |
outputFile << "{";
|
| 445 | 80x |
bool first = true; |
| 446 | 480x |
for (const auto& pair : obj) {
|
| 447 | 400x |
if (!first) {
|
| 448 | 320x |
outputFile << ","; |
| 449 |
} |
|
| 450 | 400x |
first = false; |
| 451 | 400x |
outputFile << "\"" << pair.first << "\":"; |
| 452 | 400x |
WriteJsonValue(outputFile, pair.second); |
| 453 |
} |
|
| 454 | 80x |
outputFile << "}"; |
| 455 |
} |
|
| 456 | 80x |
break; |
| 457 |
case JsonValueType::JArray: |
|
| 458 |
{
|
|
| 459 | 808x |
JsonArray& arr = jsonValue.GetArray(); |
| 460 | 808x |
outputFile << "["; |
| 461 | 808x |
bool first = true; |
| 462 | 105352x |
for (const auto& value : arr) {
|
| 463 | 104544x |
if (!first) {
|
| 464 | 103736x |
outputFile << ","; |
| 465 |
} |
|
| 466 | 104544x |
first = false; |
| 467 | 104544x |
WriteJsonValue(outputFile, value); |
| 468 |
} |
|
| 469 | 808x |
outputFile << "]"; |
| 470 |
} |
|
| 471 | 808x |
break; |
| 472 |
} |
|
| 473 |
} |
|
| 474 | ||
| 475 |
/** |
|
| 476 |
* Display a JSON value to the standard output. |
|
| 477 |
* @param jsonValue The JSON value to display. |
|
| 478 |
*/ |
|
| 479 | ! |
void JsonParser::Show(JsonValue jsonValue) {
|
| 480 | ! |
this->PrintJsonValue(std::cout, jsonValue); |
| 481 | ! |
std::cout << std::endl; |
| 482 |
} |
|
| 483 | ||
| 484 |
/** |
|
| 485 |
* Display a JSON value to an output stream. |
|
| 486 |
* @param output The output stream. |
|
| 487 |
* @param jsonValue The JSON value to display. |
|
| 488 |
*/ |
|
| 489 | ! |
void JsonParser::PrintJsonValue(std::ostream& output, JsonValue jsonValue) {
|
| 490 | ! |
switch (jsonValue.GetType()) {
|
| 491 |
case JsonValueType::Null: |
|
| 492 | ! |
output << "null"; |
| 493 | ! |
break; |
| 494 |
case JsonValueType::Number: |
|
| 495 | ! |
output << jsonValue.GetDouble(); |
| 496 | ! |
break; |
| 497 |
case JsonValueType::String: |
|
| 498 | ! |
output << "\"" << jsonValue.GetString() << "\""; |
| 499 | ! |
break; |
| 500 |
case JsonValueType::Bool: |
|
| 501 | ! |
output << (jsonValue.GetBool() ? "true" : "false"); |
| 502 | ! |
break; |
| 503 |
case JsonValueType::Object: |
|
| 504 |
{
|
|
| 505 | ! |
JsonObject& obj = jsonValue.GetObject(); |
| 506 | ! |
output << "{";
|
| 507 | ! |
bool first = true; |
| 508 | ! |
for (const auto& pair : obj) {
|
| 509 | ! |
if (!first) {
|
| 510 | ! |
output << ","; |
| 511 |
} |
|
| 512 | ! |
first = false; |
| 513 | ! |
output << "\"" << pair.first << "\":"; |
| 514 | ! |
PrintJsonValue(output, pair.second); |
| 515 |
} |
|
| 516 | ! |
output << "}"; |
| 517 |
} |
|
| 518 | ! |
break; |
| 519 |
case JsonValueType::JArray: |
|
| 520 |
{
|
|
| 521 | ! |
JsonArray& arr = jsonValue.GetArray(); |
| 522 | ! |
output << "["; |
| 523 | ! |
bool first = true; |
| 524 | ! |
for (const auto& value : arr) {
|
| 525 | ! |
if (!first) {
|
| 526 | ! |
output << ","; |
| 527 |
} |
|
| 528 | ! |
first = false; |
| 529 | ! |
PrintJsonValue(output, value); |
| 530 |
} |
|
| 531 | ! |
output << "]"; |
| 532 |
} |
|
| 533 | ! |
break; |
| 534 |
} |
|
| 535 |
} |
|
| 536 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/population/population.hpp" |
|
| 3 |
#include "../../tests/integration/integration_class.hpp" |
|
| 4 | ||
| 5 |
namespace |
|
| 6 |
{
|
|
| 7 | 15x |
TEST(IntegrationTest, MCPC0C1Work) |
| 8 |
{
|
|
| 9 | ||
| 10 | 6x |
for (int c_case = 0; c_case < 2; c_case++) |
| 11 |
{
|
|
| 12 | 8x |
for (int i_iter = 0; i_iter < 1; i_iter++) |
| 13 |
{
|
|
| 14 | 4x |
std::ofstream integration_test_log("log_integration_test.txt");
|
| 15 |
// Declare IntegrationTest object |
|
| 16 | 4x |
IntegrationTest t(1, 1); |
| 17 | 4x |
std::stringstream ss; |
| 18 | 4x |
typename fims::JsonObject::iterator it; |
| 19 | ||
| 20 | 4x |
bool good = true; |
| 21 | ||
| 22 |
// Read in input and output json files |
|
| 23 | 4x |
fims::JsonObject input; |
| 24 | 4x |
fims::JsonObject output; |
| 25 | 4x |
fims::JsonValue input_; |
| 26 | 4x |
fims::JsonValue output_; |
| 27 | ||
| 28 |
// Read inputs |
|
| 29 | 4x |
ss.str("");
|
| 30 |
// GoogleTest operates in the folder with executables "build/tests/gtest" |
|
| 31 |
// so we have to go up three directories to get into FIMS folder |
|
| 32 | 4x |
ss << "../../../tests/integration/FIMS-deterministic-inputs/C" <<c_case <<"_om_input" << i_iter + 1 << ".json"; |
| 33 | 4x |
t.ReadJson(ss.str(), input_); |
| 34 | 4x |
ss.str("");
|
| 35 | ||
| 36 |
// Read in outputs |
|
| 37 | 4x |
ss << "../../../tests/integration/FIMS-deterministic-inputs/C" <<c_case <<"_om_output" << i_iter + 1 << ".json"; |
| 38 | 4x |
t.ReadJson(ss.str(), output_); |
| 39 | 4x |
input = input_.GetObject(); |
| 40 | 4x |
output = output_.GetObject(); |
| 41 |
// Declare singleton of population class |
|
| 42 | 4x |
fims_popdy::Population<double> pop; |
| 43 | ||
| 44 |
// ConfigurePopulationModel, RunModelLoop, and CheckModelOutput |
|
| 45 |
// methods are in integration_class.hpp |
|
| 46 | 4x |
good = t.ConfigurePopulationModel(pop, input_, output_); |
| 47 | ||
| 48 | 4x |
pop.numbers_at_age = t.RunModelLoop(pop, input_); |
| 49 | 4x |
good = t.CheckModelOutput(pop, output_); |
| 50 | ||
| 51 |
// declare unfished numbers at age 1, unfished spawning bimoass, |
|
| 52 |
// and unfished biomass |
|
| 53 | 4x |
std::vector<double> expected_unfished_numbers_at_age1(pop.nyears, 0.0); |
| 54 | 4x |
std::vector<double> expected_unfished_spawning_biomass(pop.nyears, 0.0); |
| 55 | 4x |
std::vector<double> expected_unfished_biomass(pop.nyears, 0.0); |
| 56 | ||
| 57 |
// declare vector of doubles to hold |
|
| 58 |
// biomass, spawning biomass, unfished spawning biomass, |
|
| 59 |
// expected catch in weight, expected index |
|
| 60 | 4x |
std::vector<double> expected_biomass(pop.nyears, 0.0); |
| 61 | 4x |
std::vector<double> expected_spawning_biomass(pop.nyears, 0.0); |
| 62 | 4x |
std::vector<double> expected_catch(pop.nyears, 0.0); |
| 63 | 4x |
std::vector<double> expected_index(pop.nyears, 0.0); |
| 64 | ||
| 65 |
// declare vector of doubles to hold dimension folded |
|
| 66 |
// numbers at age, |
|
| 67 |
// fishing mortality at age, and total mortality at age |
|
| 68 | 4x |
std::vector<double> expected_numbers_at_age(pop.nages * pop.nyears, 0.0); |
| 69 | 4x |
std::vector<double> expected_mortality_F(pop.nages * pop.nyears, 0.0); |
| 70 | 4x |
std::vector<double> expected_mortality_Z(pop.nages * pop.nyears, 0.0); |
| 71 | ||
| 72 |
// Test unfished numbers at age, unfished spawning biomass, |
|
| 73 |
// and unfished biomass |
|
| 74 | 4x |
it = input.find("median_R0");
|
| 75 | 4x |
fims::JsonArray &R_0 = (*it).second.GetArray(); |
| 76 |
// When obtaining the numeric values, GetDouble() will convert internal integer representation |
|
| 77 |
// to a double. Note that, int and unsigned can be safely converted to double, |
|
| 78 |
// but int64_t and uint64_t may lose precision (since mantissa of double is only 52-bits). |
|
| 79 | 4x |
double log_rzero = fims_math::log(R_0[0].GetDouble()); |
| 80 | ||
| 81 | 4x |
it = input.find("Phi.0");
|
| 82 | 4x |
fims::JsonArray &Phi0 = (*it).second.GetArray();; |
| 83 | 4x |
double phi_0 = Phi0[0].GetDouble(); |
| 84 | ||
| 85 | 124x |
for (int year = 0; year < pop.nyears; year++) |
| 86 |
{
|
|
| 87 | 1560x |
for (int age = 0; age < pop.nages; age++) |
| 88 |
{
|
|
| 89 | 1440x |
int i_age_year = year * pop.nages + age; |
| 90 | ||
| 91 |
// Expect FIMS value is greater than 0.0 |
|
| 92 | 1440x |
EXPECT_GT(pop.unfished_numbers_at_age[i_age_year], 0.0) |
| 93 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 94 | 1440x |
EXPECT_LE(pop.unfished_numbers_at_age[i_age_year], fims_math::exp(log_rzero)) |
| 95 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 96 | ||
| 97 | 1440x |
EXPECT_GT(pop.unfished_spawning_biomass[year], 0.0) |
| 98 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 99 | 1440x |
EXPECT_LE(pop.unfished_spawning_biomass[year], fims_math::exp(log_rzero) * phi_0) |
| 100 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 101 | ||
| 102 | 1440x |
EXPECT_GT(pop.unfished_biomass[year], 0.0) |
| 103 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 104 |
} |
|
| 105 |
} |
|
| 106 | ||
| 107 | 52x |
for (int age = 0; age < pop.nages; age++) |
| 108 |
{
|
|
| 109 | 48x |
int i_age_year = pop.nyears * pop.nages + age; |
| 110 | 48x |
EXPECT_GT(pop.unfished_numbers_at_age[i_age_year], 0.0) |
| 111 | ! |
<< "differ at index " << i_age_year << "; year " << pop.nyears + 1 << "; age" << age; |
| 112 |
} |
|
| 113 | ||
| 114 | 4x |
EXPECT_GT(pop.unfished_spawning_biomass[pop.nyears], 0.0) |
| 115 | ! |
<< "differ at year " << pop.nyears + 1; |
| 116 | ||
| 117 | 4x |
EXPECT_GT(pop.unfished_biomass[pop.nyears], 0.0) |
| 118 | ! |
<< "differ at year " << pop.nyears + 1; |
| 119 | ||
| 120 |
// Test spawning biomass |
|
| 121 |
// find the OM json member called "SSB" |
|
| 122 | 4x |
it = output.find("SSB");
|
| 123 | ||
| 124 | 4x |
if (it != output.end()) |
| 125 |
{
|
|
| 126 | 4x |
fims::JsonArray &e = (*it).second.GetArray();; |
| 127 | 124x |
for (int year = 0; year < pop.nyears; year++) |
| 128 |
{
|
|
| 129 | 120x |
expected_spawning_biomass[year] = e[year].GetDouble(); |
| 130 |
// Expect the difference between FIMS value and the |
|
| 131 |
// expected value from the MCP OM |
|
| 132 |
// is less than 1.0 mt. |
|
| 133 | 120x |
EXPECT_NEAR(pop.spawning_biomass[year], expected_spawning_biomass[year], 1.0) |
| 134 | ! |
<< "year " << year; |
| 135 |
// Expect the difference between FIMS value and the |
|
| 136 |
// expected value from the MCP OM |
|
| 137 |
// is less than 1.0% of the expected value. |
|
| 138 | 120x |
EXPECT_LE(std::abs(pop.spawning_biomass[year] - expected_spawning_biomass[year]) / |
| 139 |
expected_spawning_biomass[year] * 100, |
|
| 140 |
1.0) |
|
| 141 | ! |
<< "year " << year; |
| 142 |
// Expect FIMS value is greater than 0.0 |
|
| 143 | 120x |
EXPECT_GT(pop.spawning_biomass[year], 0.0) |
| 144 | ! |
<< "year " << year; |
| 145 |
} |
|
| 146 |
} |
|
| 147 | 4x |
EXPECT_GT(pop.spawning_biomass[pop.nyears], 0.0) |
| 148 | ! |
<< "year " << pop.nyears + 1; |
| 149 | ||
| 150 |
// Test biomass |
|
| 151 |
// find the OM json member called "Biomass" |
|
| 152 | 4x |
it = output.find("biomass.mt");
|
| 153 | ||
| 154 | 4x |
if (it != output.end()) |
| 155 |
{
|
|
| 156 | 4x |
fims::JsonArray &e = (*it).second.GetArray();; |
| 157 | 124x |
for (int year = 0; year < pop.nyears; year++) |
| 158 |
{
|
|
| 159 | 120x |
expected_biomass[year] = e[year].GetDouble(); |
| 160 | ||
| 161 | 120x |
EXPECT_NEAR(pop.biomass[year], expected_biomass[year], 2) |
| 162 | ! |
<< "year " << year; |
| 163 |
// Expect the difference between FIMS value and the |
|
| 164 |
// expected value from the MCP OM |
|
| 165 |
// is less than 1.0% of the expected value. |
|
| 166 | 120x |
EXPECT_LE(std::abs(pop.biomass[year] - expected_biomass[year]) / |
| 167 |
expected_biomass[year] * 100, |
|
| 168 |
1.0) |
|
| 169 | ! |
<< "year " << year; |
| 170 |
// Expect FIMS value is greater than 0.0 |
|
| 171 | 120x |
EXPECT_GT(pop.biomass[year], 0.0) |
| 172 | ! |
<< "year " << year; |
| 173 |
} |
|
| 174 |
} |
|
| 175 | 4x |
EXPECT_GT(pop.biomass[pop.nyears], 0.0) |
| 176 | ! |
<< "year " << pop.nyears + 1; |
| 177 | ||
| 178 |
// Test expected catch |
|
| 179 | 4x |
it = output.find("L.mt");
|
| 180 | ||
| 181 | 4x |
if (it != output.end()) |
| 182 |
{
|
|
| 183 | 4x |
typename fims::JsonObject::iterator fleet1; |
| 184 | 4x |
fleet1 = it->second.GetObject().find("fleet1");
|
| 185 | 4x |
fims::JsonArray &fleet_catch = (*fleet1).second.GetArray(); |
| 186 | 124x |
for (int year = 0; year < pop.nyears; year++) |
| 187 |
{
|
|
| 188 | 120x |
expected_catch[year] = fleet_catch[year].GetDouble(); |
| 189 |
// Expect the difference between FIMS and OM is less than 1 mt |
|
| 190 | 120x |
EXPECT_NEAR(pop.fleets[0]->expected_catch[year], expected_catch[year], 1) |
| 191 | ! |
<< "year " << year; |
| 192 |
// Expect the difference between FIMS value and the |
|
| 193 |
// expected value from the MCP OM |
|
| 194 |
// is less than 1.0% of the expected value. |
|
| 195 | 120x |
EXPECT_LE(std::abs(pop.fleets[0]->expected_catch[year] - expected_catch[year]) / |
| 196 |
expected_catch[year] * 100, |
|
| 197 |
1.0) |
|
| 198 | ! |
<< "year " << year; |
| 199 |
// Expect FIMS value is greater than 0.0 |
|
| 200 | 120x |
EXPECT_GT(pop.fleets[0]->expected_catch[year], 0.0) |
| 201 | ! |
<< "year " << year; |
| 202 |
// Expect FIMS value = 0.0 |
|
| 203 | 120x |
EXPECT_EQ(pop.fleets[1]->expected_catch[year], 0.0) |
| 204 | ! |
<< "year " << year; |
| 205 |
} |
|
| 206 |
} |
|
| 207 | ||
| 208 |
// Test expected index |
|
| 209 | 4x |
it = output.find("survey_q");
|
| 210 | 4x |
typename fims::JsonObject::iterator fleet2_q; |
| 211 | 4x |
fleet2_q = it->second.GetObject().find("survey1");
|
| 212 | 4x |
fims::JsonArray&fleet_q = (*fleet2_q).second.GetArray(); |
| 213 | ||
| 214 | 4x |
it = output.find("survey_index_biomass");
|
| 215 | ||
| 216 | 4x |
if (it != output.end()) |
| 217 |
{
|
|
| 218 | 4x |
typename fims::JsonObject::iterator fleet2_index; |
| 219 | 4x |
fleet2_index = it->second.GetObject().find("survey1");
|
| 220 | 4x |
fims::JsonArray &fleet_index = (*fleet2_index).second.GetArray(); |
| 221 | 4x |
EXPECT_EQ(pop.fleets[0]->q[0], 1.0); |
| 222 |
// Do not use EXPECT_EQ to compare floats or doubles |
|
| 223 |
// Use EXPECT_NEAR here |
|
| 224 | 4x |
EXPECT_NEAR(pop.fleets[1]->q[0], fleet_q[0].GetDouble(), 1.0e-07); |
| 225 |
|
|
| 226 | 4x |
if(pop.fleets[1]->is_survey){
|
| 227 | 124x |
for (int year = 0; year < pop.nyears; year++) |
| 228 |
{
|
|
| 229 |
// Expect catchability of the fishing fleet = 1.0 |
|
| 230 |
// Expect expected index of the fishing fleet to be |
|
| 231 |
// greater than 0.0 |
|
| 232 | 120x |
EXPECT_GT(pop.fleets[0]->expected_index[year], 0.0) |
| 233 | ! |
<< "year " << year; |
| 234 | ||
| 235 | 120x |
expected_index[year] = fleet_index[year].GetDouble(); |
| 236 | ||
| 237 | 120x |
EXPECT_NEAR(pop.fleets[1]->expected_index[year], expected_index[year], 0.0001) |
| 238 | ! |
<< "year " << year; |
| 239 |
// Expect the difference between FIMS value and the |
|
| 240 |
// expected value from the MCP OM |
|
| 241 |
// is less than 5.0% of the expected value. |
|
| 242 | 120x |
EXPECT_LE(std::abs(pop.fleets[1]->expected_index[year] - expected_index[year]) / |
| 243 |
expected_index[year] * 100, |
|
| 244 |
5.0) |
|
| 245 | ! |
<< "year " << year; |
| 246 | ||
| 247 |
// Expect FIMS value is greater than 0.0 |
|
| 248 | 120x |
EXPECT_GT(pop.fleets[1]->expected_index[year], 0.0) |
| 249 | ! |
<< "year " << year; |
| 250 |
} |
|
| 251 |
} |
|
| 252 |
} |
|
| 253 | ||
| 254 |
// Test numbers at age |
|
| 255 |
// find the OM json member called "N.age" |
|
| 256 | 4x |
it = output.find("N.age");
|
| 257 | 4x |
if (it != output.end()) |
| 258 |
{
|
|
| 259 | 4x |
fims::JsonArray &e = (*it).second.GetArray(); |
| 260 | 124x |
for (int year = 0; year < pop.nyears; year++) |
| 261 |
{
|
|
| 262 | 1560x |
for (int age = 0; age < pop.nages; age++) |
| 263 |
{
|
|
| 264 | 1440x |
int i_age_year = year * pop.nages + age; |
| 265 | 1440x |
expected_numbers_at_age[i_age_year] = e[year].GetArray()[age].GetDouble(); |
| 266 |
// Expect the difference between FIMS value and the |
|
| 267 |
// expected value from the MCP OM |
|
| 268 |
// is less than 1.0% of the expected value. |
|
| 269 | 1440x |
EXPECT_LE(std::abs(pop.numbers_at_age[i_age_year] - expected_numbers_at_age[i_age_year]) / |
| 270 |
expected_numbers_at_age[i_age_year] * 100, |
|
| 271 |
1.0) |
|
| 272 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 273 |
|
|
| 274 |
// Expect the difference between FIMS value and the |
|
| 275 |
// expected value from the MCP OM |
|
| 276 |
// is less than 65 fish. |
|
| 277 | 1440x |
EXPECT_LE(std::abs(pop.numbers_at_age[i_age_year] - expected_numbers_at_age[i_age_year]), |
| 278 |
65) |
|
| 279 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 280 |
// Expect FIMS value is greater than 0.0 |
|
| 281 | 1440x |
EXPECT_GT(pop.numbers_at_age[i_age_year], 0.0) |
| 282 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 283 |
} |
|
| 284 |
} |
|
| 285 |
} |
|
| 286 |
// Test numbers at age in year pop.nyear+1 |
|
| 287 | 52x |
for (int age = 0; age < pop.nages; age++) |
| 288 |
{
|
|
| 289 | ||
| 290 | 48x |
int i_age_year = pop.nyears * pop.nages + age; |
| 291 | 48x |
EXPECT_GT(pop.numbers_at_age[i_age_year], 0.0) |
| 292 | ! |
<< "differ at index " << i_age_year << "; year " << pop.nyears + 1 << "; age " << age; |
| 293 |
} |
|
| 294 |
|
|
| 295 |
|
|
| 296 |
|
|
| 297 |
// Test fishing mortality at age |
|
| 298 | 4x |
it = output.find("FAA");
|
| 299 | 4x |
if (it != output.end()) |
| 300 |
{
|
|
| 301 | 4x |
fims::JsonArray &e = (*it).second.GetArray(); |
| 302 | 124x |
for (int year = 0; year < pop.nyears; year++) |
| 303 |
{
|
|
| 304 | 1560x |
for (int age = 0; age < pop.nages; age++) |
| 305 |
{
|
|
| 306 | 1440x |
int i_age_year = year * pop.nages + age; |
| 307 | 1440x |
expected_mortality_F[i_age_year] = e[year].GetArray()[age].GetDouble(); |
| 308 |
// Expect the difference between FIMS value and the |
|
| 309 |
// expected value from the MCP OM |
|
| 310 |
// is less than 0.0001. |
|
| 311 | 1440x |
EXPECT_NEAR(pop.mortality_F[i_age_year], expected_mortality_F[i_age_year], |
| 312 |
0.0001) |
|
| 313 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 314 |
// Expect FIMS value >= 0.0 |
|
| 315 | 1440x |
EXPECT_GE(pop.mortality_F[i_age_year], 0.0) |
| 316 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 317 |
} |
|
| 318 |
} |
|
| 319 |
} |
|
| 320 |
// Test total mortality at age |
|
| 321 | 4x |
it = input.find("M.age");
|
| 322 |
// integration_test_log <<"test"<<std::endl; |
|
| 323 | 4x |
if (it != input.end()) |
| 324 |
{
|
|
| 325 | 4x |
fims::JsonArray &e = (*it).second.GetArray(); |
| 326 | 124x |
for (int year = 0; year < pop.nyears; year++) |
| 327 |
{
|
|
| 328 | 1560x |
for (int age = 0; age < pop.nages; age++) |
| 329 |
{
|
|
| 330 | 1440x |
int i_age_year = year * pop.nages + age; |
| 331 | 1440x |
int i_agem1_yearm1 = (year - 1) * pop.nages + (age - 1); |
| 332 | 1440x |
expected_mortality_Z[i_age_year] = expected_mortality_F[i_age_year] + e[age].GetDouble(); |
| 333 |
// Check numbers at age mismatch issue |
|
| 334 |
// FIMS output |
|
| 335 | 1440x |
if (age < (pop.nages - 1)) // Ignore plus group |
| 336 |
{
|
|
| 337 | 1320x |
integration_test_log << "year " << year << " age " << age << " i_age_year " << i_age_year << " FIMS: " << pop.numbers_at_age[i_agem1_yearm1] << "*exp(-" << pop.mortality_Z[i_agem1_yearm1] << ")=" << pop.numbers_at_age[i_agem1_yearm1] * exp(-pop.mortality_Z[i_agem1_yearm1]) << " pop.numbers_at_age[i_age_year] " << pop.numbers_at_age[i_age_year] << " MCP OM: " << expected_numbers_at_age[i_agem1_yearm1] << "*exp(-" << expected_mortality_Z[i_agem1_yearm1] << ")=" << expected_numbers_at_age[i_agem1_yearm1] * exp(-expected_mortality_Z[i_agem1_yearm1]) << " expected_numbers_at_age[i_age_year] " << expected_numbers_at_age[i_age_year] << std::endl; |
| 338 |
} |
|
| 339 | ||
| 340 |
// R code to print MCP OM output |
|
| 341 |
// ZAA <- matrix(NA, nrow = om_input$nyr, ncol = om_input$nages) |
|
| 342 |
// for (year in 1 : om_input$nyr) |
|
| 343 |
// {
|
|
| 344 |
// for (age in 1 : om_input$nages) |
|
| 345 |
// {
|
|
| 346 |
// ZAA[year, age] < -om_output$FAA[year, age] + om_input$M.age[age] if (year > 1 & age<om_input$nages & age> 1) |
|
| 347 |
// {
|
|
| 348 |
// cat("Year", year - 1, "Age", age - 1,
|
|
| 349 |
// om_output$N.age[year - 1, age - 1], "x exp(-", ZAA[year - 1, age - 1], ")=", |
|
| 350 |
// om_output$N.age[year - 1, age - 1] * exp(-ZAA[year - 1, age - 1]), |
|
| 351 |
// "OM NAA:", om_output$N.age[year, age], "\n") |
|
| 352 |
// } |
|
| 353 |
// } |
|
| 354 |
// } |
|
| 355 | ||
| 356 |
// Expect the difference between FIMS value and the |
|
| 357 |
// expected value from the MCP OM |
|
| 358 |
// is less than 0.0001. |
|
| 359 | 1440x |
EXPECT_NEAR(pop.mortality_Z[i_age_year], expected_mortality_Z[i_age_year], |
| 360 |
0.0001) |
|
| 361 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 362 |
// Expect FIMS value is greater than 0.0 |
|
| 363 |
|
|
| 364 | 1440x |
EXPECT_GT(pop.mortality_Z[i_age_year], 0.0) |
| 365 | ! |
<< "differ at index " << i_age_year << "; year " << year << "; age" << age; |
| 366 |
} |
|
| 367 |
} |
|
| 368 |
} |
|
| 369 |
} |
|
| 370 |
} |
|
| 371 |
} |
|
| 372 |
} |
| 1 |
#include <sstream> |
|
| 2 |
#include <fstream> |
|
| 3 |
#include <iostream> |
|
| 4 | ||
| 5 |
#ifndef STD_LIB |
|
| 6 |
#define STD_LIB |
|
| 7 |
#endif |
|
| 8 | ||
| 9 |
#include "../../inst/include/population_dynamics/population/population.hpp" |
|
| 10 |
#include "../../inst/include/utilities/fims_json.hpp" |
|
| 11 | ||
| 12 |
class IntegrationTest {
|
|
| 13 |
public: |
|
| 14 |
uint32_t ncases_m = 10; |
|
| 15 |
uint32_t ninput_files_m = 160; |
|
| 16 | 4x |
bool print_statements = true; |
| 17 | ||
| 18 |
IntegrationTest() {
|
|
| 19 |
} |
|
| 20 | ||
| 21 | 8x |
IntegrationTest(uint32_t ncases, uint32_t ninput_files) |
| 22 | 8x |
: ncases_m(ncases), ninput_files_m(ninput_files) {
|
| 23 |
} |
|
| 24 | ||
| 25 |
bool Run() {
|
|
| 26 | ||
| 27 |
bool good = true; |
|
| 28 | ||
| 29 |
std::stringstream ss; |
|
| 30 |
for (uint32_t i = 0; i < this->ncases_m; i++) {
|
|
| 31 |
for (uint32_t j = 0; j < this->ninput_files_m; j++) {
|
|
| 32 |
fims::JsonValue input; |
|
| 33 |
fims::JsonValue output; |
|
| 34 | ||
| 35 |
ss.str("");
|
|
| 36 |
ss << "inputs/C" << i << "/om_input" << j + 1 << ".json"; |
|
| 37 |
this->ReadJson(ss.str(), input); |
|
| 38 | ||
| 39 |
ss.str("");
|
|
| 40 |
ss << "inputs/C" << i << "/om_output" << j + 1 << ".json"; |
|
| 41 |
this->ReadJson(ss.str(), output); |
|
| 42 | ||
| 43 |
fims_popdy::Population<double> pop; |
|
| 44 | ||
| 45 |
if (!this->ConfigurePopulationModel(pop, input, output)) {
|
|
| 46 |
good = false; |
|
| 47 |
} |
|
| 48 | ||
| 49 |
if(good){
|
|
| 50 |
this->RunModelLoop(pop, input); |
|
| 51 |
}else{
|
|
| 52 |
throw std::invalid_argument("model not good!");
|
|
| 53 |
} |
|
| 54 | ||
| 55 |
// if (!this->CheckModelOutput(pop, output)) {
|
|
| 56 |
// good = false; |
|
| 57 |
// } |
|
| 58 |
} |
|
| 59 |
} |
|
| 60 | ||
| 61 |
return good; |
|
| 62 |
} |
|
| 63 | ||
| 64 | 8x |
bool ReadJson(const std::string &path, |
| 65 |
fims::JsonValue &result) {
|
|
| 66 | ||
| 67 | 8x |
std::stringstream ss; |
| 68 | 8x |
std::ifstream infile; |
| 69 | 8x |
infile.open(path.c_str()); |
| 70 | ||
| 71 | ||
| 72 | 8x |
ss.str("");
|
| 73 | 1000x |
while (infile.good()) {
|
| 74 | 992x |
std::string line; |
| 75 | 992x |
std::getline(infile, line); |
| 76 | 992x |
ss << line << "\n"; |
| 77 |
} |
|
| 78 | 8x |
if (print_statements) {
|
| 79 | 8x |
std::cout << path << "\n"; |
| 80 |
// std::cout << ss.str() << "\n"; |
|
| 81 |
} |
|
| 82 | ||
| 83 | 8x |
fims::JsonParser parser; |
| 84 | 8x |
result = parser.Parse(ss.str()); |
| 85 | 8x |
parser.WriteToFile("out.json", result);
|
| 86 |
// json_.Parse(ss.str().c_str()); |
|
| 87 | ||
| 88 |
return true; |
|
| 89 |
} |
|
| 90 | ||
| 91 | 4x |
bool ConfigurePopulationModel(fims_popdy::Population<double> &pop, |
| 92 |
fims::JsonValue &input, |
|
| 93 |
fims::JsonValue &output) {
|
|
| 94 | ||
| 95 | 4x |
std::cout << input.GetType() << "\n"; |
| 96 |
size_t nfleets, nsurveys, nages, nyears; |
|
| 97 | ||
| 98 | 4x |
std::cout << input.GetDouble() << "\n"; |
| 99 | 4x |
if (input.GetType() == fims::JsonValueType::Object && output.GetType() == fims::JsonValueType::Object) {
|
| 100 | ||
| 101 | 4x |
fims::JsonObject& obj = input.GetObject(); |
| 102 | 4x |
fims::JsonObject& obj2 = output.GetObject(); |
| 103 | ||
| 104 | 4x |
typename fims::JsonObject::iterator it; |
| 105 | ||
| 106 | 4x |
it = obj.find("nyr");
|
| 107 | 4x |
if (it != obj.end()) {
|
| 108 | 4x |
fims::JsonValue e = (*it).second; |
| 109 | 4x |
if (e.GetType() == fims::JsonValueType::JArray) {
|
| 110 | 4x |
fims::JsonArray a = e.GetArray(); |
| 111 | 4x |
nyears = a[0].GetInt(); |
| 112 |
} |
|
| 113 | ||
| 114 | ||
| 115 | 4x |
if (print_statements) {
|
| 116 | 4x |
std::cout << "nyr " << nyears << std::endl; |
| 117 |
} |
|
| 118 |
} else {
|
|
| 119 | ! |
if (print_statements) {
|
| 120 | ! |
std::cout << "nyr not found in input\n"; |
| 121 |
} |
|
| 122 |
} |
|
| 123 | ||
| 124 |
// typename JsonObject::iterator it; |
|
| 125 | ||
| 126 | 4x |
it = obj.find("nages");
|
| 127 | 4x |
if (it != obj.end()) {
|
| 128 | 4x |
fims::JsonValue e = (*it).second; |
| 129 | 4x |
if (e.GetType() == fims::JsonValueType::JArray) {
|
| 130 | 4x |
fims::JsonArray a = e.GetArray(); |
| 131 | 4x |
nages = a[0].GetInt(); |
| 132 |
} |
|
| 133 | ||
| 134 | ||
| 135 | 4x |
if (print_statements) {
|
| 136 | 4x |
std::cout << "nages " << nages << std::endl; |
| 137 |
} |
|
| 138 |
} else {
|
|
| 139 | ! |
if (print_statements) {
|
| 140 | ! |
std::cout << "nages not found in input\n"; |
| 141 |
} |
|
| 142 |
} |
|
| 143 | ||
| 144 |
//get number of fleets |
|
| 145 | 4x |
it = obj.find("fleet_num");
|
| 146 | 4x |
if (it != obj.end()) {
|
| 147 | 4x |
fims::JsonValue e = (*it).second; |
| 148 | 4x |
if (e.GetType() == fims::JsonValueType::JArray) {
|
| 149 | 4x |
fims::JsonArray a = e.GetArray(); |
| 150 | 4x |
nfleets = a[0].GetInt(); |
| 151 |
} |
|
| 152 | ||
| 153 | 4x |
if (print_statements) {
|
| 154 | 4x |
std::cout << "nfleets " << nfleets << std::endl; |
| 155 |
} |
|
| 156 | ||
| 157 | 8x |
for (size_t i = 0; i < nfleets; i++) {
|
| 158 | 4x |
std::shared_ptr<fims_popdy::Fleet<double> > f = std::make_shared<fims_popdy::Fleet<double> >(); |
| 159 | 4x |
f->log_q.resize(1); |
| 160 | 4x |
f->Initialize(nyears, nages); |
| 161 |
// f->observed_index_data = std::make_shared<fims_data_object::DataObject<double> >(nyears); |
|
| 162 |
// f->observed_agecomp_data = std::make_shared<fims_data_object::DataObject<double> >(nyears, nages); |
|
| 163 | ||
| 164 | 4x |
std::stringstream strs; |
| 165 | 4x |
strs << "fleet" << i + 1; |
| 166 | ||
| 167 | 4x |
it = obj.find("sel_fleet");
|
| 168 | 4x |
typename fims::JsonObject::iterator fsel; |
| 169 | 4x |
if (it != obj.end()) {
|
| 170 | 4x |
fims::JsonValue e = (*it).second; |
| 171 | 4x |
if (e.GetType() == fims::JsonValueType::Object) {
|
| 172 | 4x |
fims::JsonObject o = e.GetObject(); |
| 173 | 4x |
fsel = o.find(strs.str().c_str()); |
| 174 | ||
| 175 | 4x |
if ((*fsel).second.GetType() == fims::JsonValueType::Object) {
|
| 176 | 4x |
fims::JsonObject fsel_o = (*fsel).second.GetObject(); |
| 177 | 4x |
it = fsel_o.find("pattern");
|
| 178 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 179 | ||
| 180 | 4x |
fims::JsonArray sel_pattern = (*it).second.GetArray(); |
| 181 | 4x |
if (print_statements) {
|
| 182 | 4x |
std::cout << "Selectivity:\n"; |
| 183 |
} |
|
| 184 | 4x |
if (sel_pattern[0].GetInt() == 1) {//logistic
|
| 185 | 4x |
if (print_statements) {
|
| 186 | 4x |
std::cout << "logistic\n"; |
| 187 |
} |
|
| 188 | 4x |
std::shared_ptr<fims_popdy::LogisticSelectivity<double> > selectivity = std::make_shared<fims_popdy::LogisticSelectivity<double> >(); |
| 189 | ||
| 190 | 4x |
it = fsel_o.find("A50.sel1");
|
| 191 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 192 | 4x |
fims::JsonArray a50 = (*it).second.GetArray(); |
| 193 | 4x |
selectivity->inflection_point.resize(1); |
| 194 | 4x |
selectivity->inflection_point[0] = a50[0].GetDouble(); |
| 195 | 4x |
if (print_statements) {
|
| 196 | 4x |
std::cout << "A50 " << selectivity->inflection_point[0] << "\n"; |
| 197 |
} |
|
| 198 |
} |
|
| 199 | ||
| 200 | 4x |
it = fsel_o.find("slope.sel1");
|
| 201 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 202 | 4x |
fims::JsonArray slope = (*it).second.GetArray(); |
| 203 | 4x |
selectivity->slope.resize(1); |
| 204 | 4x |
selectivity->slope[0] = slope[0].GetDouble(); |
| 205 | 4x |
if (print_statements) {
|
| 206 | 4x |
std::cout << "slope " << selectivity->slope[0] << "\n"; |
| 207 |
} |
|
| 208 |
} |
|
| 209 | ||
| 210 | 4x |
f->selectivity = selectivity; |
| 211 | ||
| 212 | ||
| 213 | 4x |
} else if (sel_pattern[0].GetInt() == 2) {//double logistic
|
| 214 | ! |
if (print_statements) {
|
| 215 | ! |
std::cout << "double logistic\n"; |
| 216 |
} |
|
| 217 | ! |
std::shared_ptr<fims_popdy::DoubleLogisticSelectivity<double> > selectivity = std::make_shared<fims_popdy::DoubleLogisticSelectivity<double> >(); |
| 218 | ||
| 219 | ! |
it = fsel_o.find("A50.sel1");
|
| 220 | ! |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 221 | ! |
fims::JsonArray a50 = (*it).second.GetArray(); |
| 222 | ! |
selectivity->inflection_point_asc.resize(1); |
| 223 | ! |
selectivity->inflection_point_asc[0] = a50[0].GetDouble(); |
| 224 | ! |
if (print_statements) {
|
| 225 | ! |
std::cout << "A50 asc " << selectivity->inflection_point_asc[0] << "\n"; |
| 226 |
} |
|
| 227 |
} |
|
| 228 | ||
| 229 | ! |
it = fsel_o.find("slope.sel1");
|
| 230 | ! |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 231 | ! |
fims::JsonArray slope = (*it).second.GetArray(); |
| 232 | ! |
selectivity->slope_asc.resize(1); |
| 233 | ! |
selectivity->slope_asc[0] = slope[0].GetDouble(); |
| 234 | ! |
if (print_statements) {
|
| 235 | ! |
std::cout << "slope asc " << selectivity->slope_asc[0] << "\n"; |
| 236 |
} |
|
| 237 |
} |
|
| 238 | ||
| 239 | ! |
it = fsel_o.find("A50.sel2");
|
| 240 | ! |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 241 | ! |
fims::JsonArray a50 = (*it).second.GetArray(); |
| 242 | ! |
selectivity->inflection_point_desc.resize(1); |
| 243 | ! |
selectivity->inflection_point_desc[0] = a50[0].GetDouble(); |
| 244 | ! |
if (print_statements) {
|
| 245 | ! |
std::cout << "A50 desc " << selectivity->inflection_point_desc[0] << "\n"; |
| 246 |
} |
|
| 247 |
} |
|
| 248 | ||
| 249 | ! |
it = fsel_o.find("slope.sel2");
|
| 250 | ! |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 251 | ! |
fims::JsonArray slope = (*it).second.GetArray(); |
| 252 | ! |
selectivity->slope_desc.resize(1); |
| 253 | ! |
selectivity->slope_desc[0] = slope[0].GetDouble(); |
| 254 | ! |
if (print_statements) {
|
| 255 | ! |
std::cout << "slope desc " << selectivity->slope_desc[0] << "\n"; |
| 256 |
} |
|
| 257 |
} |
|
| 258 | ! |
f->selectivity = selectivity; |
| 259 |
} |
|
| 260 | ||
| 261 |
} |
|
| 262 | ||
| 263 |
} |
|
| 264 |
} |
|
| 265 | ||
| 266 |
} |
|
| 267 | ||
| 268 | ||
| 269 | 4x |
f->log_q[0] = 0.0; |
| 270 | 4x |
it = obj.find("f");
|
| 271 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 272 | 4x |
fims::JsonArray f_values = (*it).second.GetArray(); |
| 273 | 124x |
for (int i = 0; i < f_values.size(); i++) {
|
| 274 | 120x |
f->Fmort[i] = f_values[i].GetDouble(); |
| 275 | 120x |
f->log_Fmort[i] = std::log(f_values[i].GetDouble()); |
| 276 | 120x |
if (print_statements) {
|
| 277 | 120x |
std::cout << f->Fmort[i] << " "; |
| 278 |
} |
|
| 279 |
} |
|
| 280 | ||
| 281 |
} |
|
| 282 | ||
| 283 | 4x |
if (print_statements) {
|
| 284 | 4x |
std::cout << "\n"; |
| 285 |
} |
|
| 286 | 4x |
pop.fleets.push_back(f); |
| 287 |
} |
|
| 288 | ||
| 289 |
} else {
|
|
| 290 | ! |
if (print_statements) {
|
| 291 | ! |
std::cout << "nfleets not found in input\n"; |
| 292 |
} |
|
| 293 |
} |
|
| 294 | ||
| 295 | 4x |
it = obj.find("survey_num");
|
| 296 | 4x |
if (it != obj.end()) {
|
| 297 | 4x |
fims::JsonValue e = (*it).second; |
| 298 | 4x |
if (e.GetType() == fims::JsonValueType::JArray) {
|
| 299 | 4x |
fims::JsonArray a = e.GetArray(); |
| 300 | 4x |
nsurveys = a[0].GetInt(); |
| 301 |
} |
|
| 302 | ||
| 303 | 4x |
if (print_statements) {
|
| 304 | 4x |
std::cout << "nsurveys " << nsurveys << std::endl; |
| 305 |
} |
|
| 306 | ||
| 307 | 8x |
for (size_t i = 0; i < nsurveys; i++) {
|
| 308 | 4x |
std::shared_ptr<fims_popdy::Fleet<double> > s = std::make_shared<fims_popdy::Fleet<double> >(); |
| 309 | 4x |
s->is_survey = true; |
| 310 | 4x |
s->log_q.resize(1); |
| 311 | 4x |
s->Initialize(nyears, nages); |
| 312 |
// s->observed_index_data = std::make_shared<fims_data_object::DataObject<double> >(nyears); |
|
| 313 |
// s->observed_agecomp_data = std::make_shared<fims_data_object::DataObject<double> >(nyears, nages); |
|
| 314 | ||
| 315 | 4x |
std::stringstream strs; |
| 316 | 4x |
strs << "survey" << i + 1; |
| 317 | ||
| 318 | 4x |
it = obj.find("sel_survey");
|
| 319 | 4x |
typename fims::JsonObject::iterator fsel; |
| 320 | 4x |
if (it != obj.end()) {
|
| 321 | 4x |
fims::JsonValue e = (*it).second; |
| 322 | 4x |
if (e.GetType() == fims::JsonValueType::Object) {
|
| 323 | 4x |
fims::JsonObject o = e.GetObject(); |
| 324 | 4x |
fsel = o.find(strs.str().c_str()); |
| 325 | ||
| 326 | ||
| 327 | 4x |
if ((*fsel).second.GetType() == fims::JsonValueType::Object) {
|
| 328 | ||
| 329 | ||
| 330 | 4x |
fims::JsonObject fsel_o = (*fsel).second.GetObject(); |
| 331 | 4x |
it = fsel_o.find("pattern");
|
| 332 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 333 | ||
| 334 | 4x |
fims::JsonArray sel_pattern = (*it).second.GetArray(); |
| 335 | ||
| 336 | 4x |
if (sel_pattern[0].GetInt() == 1) {//logistic
|
| 337 | 4x |
std::shared_ptr<fims_popdy::LogisticSelectivity<double> > selectivity = std::make_shared<fims_popdy::LogisticSelectivity<double> >(); |
| 338 | ||
| 339 | 4x |
it = fsel_o.find("A50.sel1");
|
| 340 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 341 | 4x |
fims::JsonArray a50 = (*it).second.GetArray(); |
| 342 | 4x |
selectivity->inflection_point.resize(1); |
| 343 | 4x |
selectivity->inflection_point[0] = a50[0].GetDouble(); |
| 344 |
} |
|
| 345 | ||
| 346 | 4x |
it = fsel_o.find("slope.sel1");
|
| 347 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 348 | 4x |
fims::JsonArray slope = (*it).second.GetArray(); |
| 349 | 4x |
selectivity->slope.resize(1); |
| 350 | 4x |
selectivity->slope[0] = slope[0].GetDouble(); |
| 351 |
} |
|
| 352 | ||
| 353 | 4x |
s->selectivity = selectivity; |
| 354 | ||
| 355 | ||
| 356 | ||
| 357 | 4x |
} else if (sel_pattern[0].GetInt() == 2) {//double logistic
|
| 358 | ! |
std::shared_ptr<fims_popdy::DoubleLogisticSelectivity<double> > selectivity = std::make_shared<fims_popdy::DoubleLogisticSelectivity<double> >(); |
| 359 | ||
| 360 | ! |
it = fsel_o.find("A50.sel1");
|
| 361 | ! |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 362 | ! |
fims::JsonArray a50 = (*it).second.GetArray(); |
| 363 | ! |
selectivity->inflection_point_asc.resize(1); |
| 364 | ! |
selectivity->inflection_point_asc[0] = a50[0].GetDouble(); |
| 365 |
} |
|
| 366 | ||
| 367 | ! |
it = fsel_o.find("slope.sel1");
|
| 368 | ! |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 369 | ! |
fims::JsonArray slope = (*it).second.GetArray(); |
| 370 | ! |
selectivity->slope_asc.resize(1); |
| 371 | ! |
selectivity->slope_asc[0] = slope[0].GetDouble(); |
| 372 |
} |
|
| 373 | ||
| 374 | ! |
it = fsel_o.find("A50.sel2");
|
| 375 | ! |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 376 | ! |
fims::JsonArray a50 = (*it).second.GetArray(); |
| 377 | ! |
selectivity->inflection_point_desc.resize(1); |
| 378 | ! |
selectivity->inflection_point_desc[0] = a50[0].GetDouble(); |
| 379 |
} |
|
| 380 | ||
| 381 | ! |
it = fsel_o.find("slope.sel2");
|
| 382 | ! |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 383 | ! |
fims::JsonArray slope = (*it).second.GetArray(); |
| 384 | ! |
selectivity->slope_desc.resize(1); |
| 385 | ! |
selectivity->slope_desc[0] = slope[0].GetDouble(); |
| 386 |
} |
|
| 387 | ! |
s->selectivity = selectivity; |
| 388 |
} |
|
| 389 | ||
| 390 |
} |
|
| 391 | ||
| 392 |
} |
|
| 393 |
} |
|
| 394 | ||
| 395 |
} |
|
| 396 | ||
| 397 | ||
| 398 | 4x |
s->log_q[0] = 0.0; |
| 399 | 4x |
it = obj2.find("survey_q");
|
| 400 | ||
| 401 | ||
| 402 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::Object) {
|
| 403 |
// f->log_q = fims_math::log((*it).second.GetDouble()); |
|
| 404 | 4x |
fims::JsonObject qobj = (*it).second.GetObject(); |
| 405 | ||
| 406 | 4x |
typename fims::JsonObject::iterator qit = qobj.find("survey1");
|
| 407 | ||
| 408 | 4x |
if ((*qit).second.GetType() == fims::JsonValueType::JArray) {
|
| 409 | 4x |
fims::JsonArray a = (*qit).second.GetArray(); |
| 410 | 4x |
s->log_q[0] = fims_math::log(a[0].GetDouble()); |
| 411 | 4x |
if (this->print_statements) {
|
| 412 | 4x |
std::cout << "q = " << a[0].GetDouble() << "\nlog(q) = " << s->log_q << "\n"; |
| 413 |
} |
|
| 414 |
} |
|
| 415 |
} |
|
| 416 | ||
| 417 | ||
| 418 | ||
| 419 | 4x |
pop.fleets.push_back(s); |
| 420 | ||
| 421 |
} |
|
| 422 | ||
| 423 |
} else {
|
|
| 424 | ! |
if (print_statements) {
|
| 425 | ! |
std::cout << "nsurveys not found in input\n"; |
| 426 |
} |
|
| 427 |
} |
|
| 428 | ||
| 429 | 4x |
pop.nfleets = pop.fleets.size(); |
| 430 | ||
| 431 |
// initialize population |
|
| 432 | 4x |
pop.numbers_at_age.resize((nyears + 1) * nages); |
| 433 | 4x |
pop.Initialize(nyears, 1, nages); |
| 434 | ||
| 435 |
// Set initial size to value from MCP C0 |
|
| 436 | 4x |
it = obj2.find("N.age");
|
| 437 | 4x |
if (it != obj2.end()) {
|
| 438 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 439 | 4x |
fims::JsonArray n = (*it).second.GetArray(); |
| 440 | 4x |
if (n[0].GetType() == fims::JsonValueType::JArray) {
|
| 441 | 4x |
fims::JsonArray init_n = n[0].GetArray(); |
| 442 | 52x |
for (size_t i = 0; i < pop.nages; i++) {
|
| 443 | 48x |
pop.log_init_naa[i] = std::log(init_n[i].GetDouble()); |
| 444 |
} |
|
| 445 |
} |
|
| 446 |
} |
|
| 447 |
} |
|
| 448 | ||
| 449 | 4x |
it = obj.find("ages");
|
| 450 | 4x |
if (it != obj.end()) {
|
| 451 | ||
| 452 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 453 | 4x |
if (print_statements) {
|
| 454 | 4x |
std::cout << "ages: "; |
| 455 |
} |
|
| 456 | 4x |
fims::JsonArray ages = (*it).second.GetArray(); |
| 457 | 52x |
for (int i = 0; i < ages.size(); i++) {
|
| 458 | 48x |
pop.ages[i] = ages[i].GetDouble(); |
| 459 | 48x |
if (print_statements) {
|
| 460 | 48x |
std::cout << pop.ages[i] << " "; |
| 461 |
} |
|
| 462 |
} |
|
| 463 | 4x |
if (print_statements) {
|
| 464 | 4x |
std::cout << "\n"; |
| 465 |
} |
|
| 466 |
} |
|
| 467 | ||
| 468 | ||
| 469 |
} else {
|
|
| 470 | ! |
if (print_statements) {
|
| 471 | ! |
std::cout << "ages not found in input\n"; |
| 472 |
} |
|
| 473 |
} |
|
| 474 | ||
| 475 | 4x |
it = obj.find("year");
|
| 476 | 4x |
if (it != obj.end()) {
|
| 477 | ||
| 478 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 479 | 4x |
if (print_statements) {
|
| 480 | 4x |
std::cout << "year: "; |
| 481 |
} |
|
| 482 | 4x |
fims::JsonArray years = (*it).second.GetArray(); |
| 483 | 124x |
for (int i = 0; i < years.size(); i++) {
|
| 484 | 120x |
pop.years[i] = years[i].GetDouble(); |
| 485 | 120x |
if (print_statements) {
|
| 486 | 120x |
std::cout << pop.years[i] << " "; |
| 487 |
} |
|
| 488 |
} |
|
| 489 | 4x |
if (print_statements) {
|
| 490 | 4x |
std::cout << "\n"; |
| 491 |
} |
|
| 492 |
} |
|
| 493 | ||
| 494 | ||
| 495 |
} else {
|
|
| 496 | ! |
if (print_statements) {
|
| 497 | ! |
std::cout << "years not found in input\n"; |
| 498 |
} |
|
| 499 |
} |
|
| 500 | 4x |
if (print_statements) {
|
| 501 | 4x |
std::cout << "\nMortality:\n"; |
| 502 |
} |
|
| 503 | 4x |
it = obj.find("M");
|
| 504 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 505 | 4x |
fims::JsonArray m = (*it).second.GetArray(); |
| 506 | 4x |
double log_M = std::log(m[0].GetDouble()); |
| 507 | 4x |
std::fill(pop.log_M.begin(), pop.log_M.end(), log_M); |
| 508 | 4x |
if (print_statements) {
|
| 509 | 4x |
std::cout << pop.log_M.size() << "\n"; |
| 510 | 4x |
std::cout << "log_M "; |
| 511 | 1444x |
for (size_t i = 0; i < pop.log_M.size(); i++) {
|
| 512 | 1440x |
std::cout << pop.log_M[i] << " "; |
| 513 |
} |
|
| 514 | 4x |
std::cout << std::endl; |
| 515 |
} |
|
| 516 |
} |
|
| 517 | ||
| 518 | ||
| 519 |
// set recruitment |
|
| 520 |
std::shared_ptr<fims_popdy::SRBevertonHolt<double> > rec = |
|
| 521 | 4x |
std::make_shared<fims_popdy::SRBevertonHolt<double> >(); |
| 522 | 4x |
if (print_statements) {
|
| 523 | 4x |
std::cout << "\nRecruitment:\n"; |
| 524 |
} |
|
| 525 | 4x |
it = obj.find("R0");
|
| 526 | 4x |
if (it != obj.end()) {
|
| 527 | 4x |
if ((*it).second.GetType() ==fims::JsonValueType::JArray) {
|
| 528 | 4x |
double r0 = (*it).second.GetArray()[0].GetDouble(); |
| 529 | 4x |
rec->log_rzero.resize(1); |
| 530 | 4x |
rec->log_rzero[0] = std::log(r0); |
| 531 | 4x |
if (print_statements) {
|
| 532 | 4x |
std::cout << "R0 " << rec->log_rzero[0] << "| \n"; |
| 533 |
} |
|
| 534 |
} |
|
| 535 |
} else {
|
|
| 536 | ! |
if (print_statements) {
|
| 537 | ! |
std::cout << "'R0' not found.\n"; |
| 538 |
} |
|
| 539 |
} |
|
| 540 | ||
| 541 | 4x |
it = obj.find("h");
|
| 542 | 4x |
if (it != obj.end()) {
|
| 543 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 544 | 4x |
rec->logit_steep.resize(1); |
| 545 | 4x |
rec->logit_steep[0] = fims_math::logit(0.2, 1.0, (*it).second.GetArray()[0].GetDouble()); |
| 546 | 4x |
if (print_statements) {
|
| 547 | 4x |
std::cout << "'h' " << rec->logit_steep[0] << " \n"; |
| 548 |
} |
|
| 549 |
} |
|
| 550 |
} else {
|
|
| 551 | ! |
if (print_statements) {
|
| 552 | ! |
std::cout << "'h' not found.\n"; |
| 553 |
} |
|
| 554 |
} |
|
| 555 | ||
| 556 | 4x |
it = obj.find("logR.resid");
|
| 557 |
/*the log_recruit_dev vector does not include a value for year == 0 |
|
| 558 |
and is of length nyears - 1 where the first position of the vector |
|
| 559 |
corresponds to the second year of the time series.*/ |
|
| 560 | 4x |
rec->log_recruit_devs.resize(nyears); |
| 561 | 4x |
std::fill(rec->log_recruit_devs.begin(), rec->log_recruit_devs.end(), 0.0); |
| 562 | 4x |
if (it != obj.end()) {
|
| 563 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 564 | 4x |
fims::JsonArray rdev = (*it).second.GetArray(); |
| 565 | 4x |
if (print_statements) {
|
| 566 | 4x |
std::cout << "recruitment deviations: "; |
| 567 |
} |
|
| 568 | 120x |
for (size_t i = 0; i < rec->log_recruit_devs.size()-1; i++) {
|
| 569 | 116x |
rec->log_recruit_devs[i] = rdev[i+1].GetDouble(); |
| 570 | 116x |
if (print_statements) {
|
| 571 | 116x |
std::cout << rec->log_recruit_devs[i] << " "; |
| 572 |
} |
|
| 573 |
} |
|
| 574 | 4x |
if (print_statements) {
|
| 575 | 4x |
std::cout << "\n"; |
| 576 |
} |
|
| 577 |
} |
|
| 578 |
} else {
|
|
| 579 | ! |
if (print_statements) {
|
| 580 | ! |
std::cout << "'logR.resid' not found.\n"; |
| 581 |
} |
|
| 582 |
} |
|
| 583 | 4x |
pop.recruitment = rec; |
| 584 | ||
| 585 |
// set maturity |
|
| 586 |
std::shared_ptr<fims_popdy::LogisticMaturity<double> > mat = |
|
| 587 | 4x |
std::make_shared<fims_popdy::LogisticMaturity<double> >(); |
| 588 | ||
| 589 | 4x |
if (print_statements) {
|
| 590 | 4x |
std::cout << "\nMaturity:\n"; |
| 591 |
} |
|
| 592 | 4x |
it = obj.find("A50.mat");
|
| 593 | 4x |
if (it != obj.end()) {
|
| 594 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 595 | 4x |
mat->inflection_point.resize(1); |
| 596 | 4x |
mat->inflection_point[0] = (*it).second.GetArray()[0].GetDouble(); |
| 597 | 4x |
if (print_statements) {
|
| 598 | 4x |
std::cout << "inflection_point.mat " << mat->inflection_point[0] << " \n"; |
| 599 |
} |
|
| 600 |
} |
|
| 601 |
} else {
|
|
| 602 | ! |
if (print_statements) {
|
| 603 | ! |
std::cout << "'A50.mat' not found.\n"; |
| 604 |
} |
|
| 605 |
} |
|
| 606 | ||
| 607 | 4x |
pop.maturity = mat; |
| 608 | ||
| 609 | 4x |
it = obj.find("slope.mat");
|
| 610 | 4x |
if (it != obj.end()) {
|
| 611 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 612 | 4x |
mat->slope.resize(1); |
| 613 | 4x |
mat->slope[0] = (*it).second.GetArray()[0].GetDouble(); |
| 614 | 4x |
if (print_statements) {
|
| 615 | 4x |
std::cout << "slope.mat " << mat->slope[0] << " \n"; |
| 616 |
} |
|
| 617 |
} |
|
| 618 |
} else {
|
|
| 619 | ! |
if (print_statements) {
|
| 620 | ! |
std::cout << "'slope.mat' not found.\n"; |
| 621 |
} |
|
| 622 |
} |
|
| 623 | ||
| 624 |
// set empirical growth |
|
| 625 | 4x |
std::shared_ptr<fims_popdy::EWAAgrowth<double> > growth = std::make_shared<fims_popdy::EWAAgrowth<double> >(); |
| 626 | 4x |
std::cout << "Growth:\n"; |
| 627 | ||
| 628 | 4x |
it = obj.find("W.kg");
|
| 629 | 4x |
if (it != obj.end()) {
|
| 630 | 4x |
if ((*it).second.GetType() == fims::JsonValueType::JArray) {
|
| 631 | 4x |
fims::JsonArray wt = (*it).second.GetArray(); |
| 632 | 4x |
if (print_statements) {
|
| 633 | 4x |
std::cout << "W.kg: "; |
| 634 |
} |
|
| 635 | 52x |
for (size_t i = 0; i < pop.ages.size(); i++) {
|
| 636 | 48x |
growth->ewaa[static_cast<double> (pop.ages[i])] = wt[i].GetDouble() / 1000.0; |
| 637 | 48x |
if (print_statements) {
|
| 638 | 48x |
std::cout << growth->ewaa[static_cast<double> (pop.ages[i])] << " "; |
| 639 |
} |
|
| 640 |
} |
|
| 641 | 4x |
if (print_statements) {
|
| 642 | 4x |
std::cout << "\n"; |
| 643 |
} |
|
| 644 |
} |
|
| 645 |
} else {
|
|
| 646 | ! |
if (print_statements) {
|
| 647 | ! |
std::cout << "'logR.resid' not found.\n"; |
| 648 |
} |
|
| 649 |
} |
|
| 650 | ||
| 651 | 4x |
pop.growth = growth; |
| 652 | ||
| 653 | 4x |
return true; |
| 654 |
} |
|
| 655 | ||
| 656 | ! |
return false; |
| 657 |
} |
|
| 658 | ||
| 659 | 4x |
std::vector<double> RunModelLoop(fims_popdy::Population<double> &pop, |
| 660 |
const fims::JsonValue & input) {
|
|
| 661 | ||
| 662 | 4x |
fims::JsonObject output; |
| 663 | 4x |
fims::JsonArray array; |
| 664 | ||
| 665 | ||
| 666 | ||
| 667 | 4x |
pop.Evaluate(); |
| 668 | ||
| 669 | 4x |
if (print_statements) {
|
| 670 | 4x |
std::cout << "Numbers at age:\n"; |
| 671 |
} |
|
| 672 | 124x |
for (int i = 0; i < pop.nyears; i++) {
|
| 673 | 1560x |
for (int j = 0; j < pop.nages; j++) {
|
| 674 | 1440x |
if (print_statements) {
|
| 675 | 1440x |
std::cout << pop.numbers_at_age[i * pop.nages + j] << " "; |
| 676 |
} |
|
| 677 | 1440x |
array.push_back(pop.numbers_at_age[i * pop.nages + j]); |
| 678 |
} |
|
| 679 | 120x |
if (print_statements) {
|
| 680 | 120x |
std::cout << std::endl; |
| 681 |
} |
|
| 682 |
} |
|
| 683 | ||
| 684 | 4x |
output["NumbersAtAge"] = array; |
| 685 | ||
| 686 | 4x |
if (print_statements) {
|
| 687 | 4x |
std::cout << "\n\n" |
| 688 | 4x |
<< std::endl; |
| 689 |
} |
|
| 690 | ||
| 691 | ||
| 692 | 4x |
return pop.numbers_at_age; |
| 693 |
} |
|
| 694 | ||
| 695 | 4x |
bool CheckModelOutput(fims_popdy::Population<double> &pop, |
| 696 |
fims::JsonValue &output) {
|
|
| 697 | 4x |
return true; |
| 698 |
} |
|
| 699 |
}; |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/population/population.hpp" |
|
| 3 |
#include "../../tests/gtest/test_population_test_fixture.hpp" |
|
| 4 | ||
| 5 |
namespace |
|
| 6 |
{
|
|
| 7 | 22x |
TEST_F(PopulationEvaluateTestFixture, CalculateMaturityAA_works) |
| 8 |
{
|
|
| 9 | 3x |
double inflection_point = 6; |
| 10 | 3x |
double slope = 0.15; |
| 11 | 3x |
std::vector<double> expect_maturity(nyears * nages, 0); |
| 12 | ||
| 13 | 93x |
for (size_t year = 0; year < nyears; year++) {
|
| 14 | 1170x |
for (size_t age = 0; age < nages; age++){
|
| 15 | 1080x |
int i_age_year = year * population.nages + age; |
| 16 | 1080x |
population.CalculateMaturityAA(i_age_year, age); |
| 17 | 1080x |
expect_maturity[i_age_year] = 1.0/(1.0+exp(-(population.ages[age]-inflection_point)*slope)); |
| 18 |
} |
|
| 19 |
} |
|
| 20 | ||
| 21 | 3x |
EXPECT_NEAR(population.proportion_mature_at_age[10], expect_maturity[10], 0.0001); |
| 22 |
} |
|
| 23 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/population/population.hpp" |
|
| 3 |
#include "../../tests/gtest/test_population_test_fixture.hpp" |
|
| 4 | ||
| 5 |
namespace |
|
| 6 |
{
|
|
| 7 | 25x |
TEST_F(PopulationEvaluateTestFixture, CalculateNumbersAA_works) |
| 8 |
{
|
|
| 9 | ||
| 10 | 3x |
std::vector<double> mortality_F(nyears * nages, 0); |
| 11 | 3x |
std::vector<double> test_naa((nyears + 1) * nages, 0); |
| 12 | ||
| 13 | 1119x |
for (int i = 0; i < (nyears + 1) * nages; i++) |
| 14 |
{
|
|
| 15 | 1116x |
test_naa[i] = population.numbers_at_age[i]; |
| 16 |
} |
|
| 17 |
|
|
| 18 | 3x |
test_naa[i_age_year] = test_naa[i_agem1_yearm1] * exp(-population.mortality_Z[i_agem1_yearm1]); |
| 19 |
|
|
| 20 | 3x |
EXPECT_EQ(population.numbers_at_age[i_age_year], test_naa[i_age_year]); |
| 21 | 3x |
EXPECT_GT(population.numbers_at_age[i_age_year], 0); |
| 22 |
} |
|
| 23 | ||
| 24 | 25x |
TEST_F(PopulationEvaluateTestFixture, CalculateNumbersAA_PlusGroup_works) |
| 25 |
{
|
|
| 26 | ||
| 27 | 3x |
int year = 4; |
| 28 | 3x |
int age = population.nages - 1; |
| 29 | 3x |
int i_age_year = year * population.nages + age; |
| 30 | 3x |
int i_agem1_yearm1 = (year - 1) * population.nages + age - 1; |
| 31 | ||
| 32 | 3x |
population.CalculateMortality(i_age_year, year, age); |
| 33 | 3x |
population.CalculateNumbersAA(i_age_year, i_agem1_yearm1, age); |
| 34 | ||
| 35 | 3x |
std::vector<double> mortality_F(nyears * nages, 0); |
| 36 | 3x |
std::vector<double> test_naa((nyears + 1) * nages, 0); |
| 37 | ||
| 38 | 1119x |
for (int i = 0; i < (nyears + 1) * nages; i++) |
| 39 |
{
|
|
| 40 | 1116x |
test_naa[i] = population.numbers_at_age[i]; |
| 41 |
} |
|
| 42 |
|
|
| 43 | 3x |
test_naa[i_age_year] = test_naa[i_agem1_yearm1] * exp(-population.mortality_Z[i_agem1_yearm1]); |
| 44 | ||
| 45 |
// plus group calculation |
|
| 46 | 3x |
test_naa[i_age_year] = |
| 47 | 6x |
test_naa[i_age_year] + |
| 48 | 3x |
test_naa[i_agem1_yearm1 + 1] * |
| 49 | 3x |
exp(-population.mortality_Z[i_agem1_yearm1 + 1]); |
| 50 | ||
| 51 | 3x |
EXPECT_EQ(population.numbers_at_age[i_age_year], test_naa[i_age_year]); |
| 52 | 3x |
EXPECT_GT(population.numbers_at_age[i_age_year], 0); |
| 53 |
} |
|
| 54 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/population/population.hpp" |
|
| 3 |
#include "../../tests/gtest/test_population_test_fixture.hpp" |
|
| 4 | ||
| 5 |
//Not working |
|
| 6 |
namespace |
|
| 7 |
{
|
|
| 8 | ||
| 9 | 22x |
TEST_F(PopulationEvaluateTestFixture, CalculateRecruitment_works) |
| 10 |
{
|
|
| 11 |
// calculating spawning biomass for year 4 |
|
| 12 | 3x |
int sb_year = 4; |
| 13 | 3x |
int sb_age = 0; |
| 14 | 3x |
int sb_i_age_year = sb_year * population.nages + sb_age; |
| 15 | 3x |
int sb_i_agem1_yearm1 = (sb_year - 1) * population.nages + sb_age - 1; |
| 16 | ||
| 17 | 3x |
population.CalculateMortality(sb_i_age_year, sb_year, sb_age); |
| 18 | 3x |
population.CalculateNumbersAA(sb_i_age_year, sb_i_agem1_yearm1, sb_age); |
| 19 | 93x |
for (size_t year = 0; year < nyears; year++) {
|
| 20 | 1170x |
for (size_t age = 0; age < nages; age++){
|
| 21 | 1080x |
int i_age_year = year * population.nages + age; |
| 22 | 1080x |
population.CalculateMaturityAA(i_age_year, age); |
| 23 |
} |
|
| 24 |
} |
|
| 25 | 3x |
population.CalculateSpawningBiomass(sb_i_age_year, sb_year, sb_age); |
| 26 | ||
| 27 |
// calculating phi0 |
|
| 28 | 3x |
double phi0 = population.CalculateSBPR0(); |
| 29 |
|
|
| 30 |
// calculating recruitment for year 5 |
|
| 31 | 3x |
int r_year = 5; |
| 32 | 3x |
int r_age = 0; // just calculating for age 0 |
| 33 | 3x |
int r_i_age_year = r_year * population.nages + r_age; |
| 34 |
// specifying steepness and rzero values for calculations |
|
| 35 |
// values from test_population_test_fixture.hpp |
|
| 36 | 3x |
double steep = 0.75; |
| 37 | 3x |
double rzero = 1000000; |
| 38 |
|
|
| 39 |
// vector for storing expected recruitment |
|
| 40 | 3x |
std::vector<double> expect_recruitment(population.nyears * population.nages, 0.0); |
| 41 |
|
|
| 42 |
/*the log_recruit_dev vector does not include a value for year == 0 |
|
| 43 |
and is of length nyears - 1 where the first position of the vector |
|
| 44 |
corresponds to the second year of the time series.*/ |
|
| 45 | 3x |
expect_recruitment[r_i_age_year] = |
| 46 | 6x |
(0.8 * rzero * steep * population.spawning_biomass[sb_year]) / |
| 47 | 6x |
(0.2 * phi0 * rzero * (1.0 - steep) + population.spawning_biomass[sb_year] * (steep - 0.2)) * fims_math::exp(population.recruitment->log_recruit_devs[r_year-1]); |
| 48 |
|
|
| 49 |
// calculate recruitment in population module |
|
| 50 | 3x |
population.CalculateRecruitment(r_i_age_year, r_year, r_year); |
| 51 |
|
|
| 52 |
// testing that expected recruitment and population.numbers_at_age match |
|
| 53 |
// EXPECT_DOUBLE_EQ() verifies that the two double values are approximately equal, to within 4 ULPs from each other. |
|
| 54 | 3x |
EXPECT_DOUBLE_EQ(population.numbers_at_age[r_i_age_year], expect_recruitment[r_i_age_year]); |
| 55 |
// testing that population.numbers_at_age > 0.0 |
|
| 56 | 3x |
EXPECT_GT(population.numbers_at_age[r_i_age_year], 0.0); |
| 57 |
} |
|
| 58 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/population/population.hpp" |
|
| 3 |
#include "../../tests/gtest/test_population_test_fixture.hpp" |
|
| 4 | ||
| 5 |
namespace |
|
| 6 |
{
|
|
| 7 | ||
| 8 | 28x |
TEST_F(PopulationPrepareTestFixture, CalculateMortality_works) |
| 9 |
{
|
|
| 10 | 93x |
for (int year = 0; year < population.nyears; year++) |
| 11 |
{
|
|
| 12 | 1170x |
for (int age = 0; age < population.nages; age++) |
| 13 |
{
|
|
| 14 | 1080x |
int i_age_year = year * population.nages + age; |
| 15 |
// Call FIMS CalculateMortality() function to compare FIMS mortality values with "true" values later |
|
| 16 | 1080x |
population.CalculateMortality(i_age_year, year, age); |
| 17 | ||
| 18 | 1080x |
std::vector<double> mortality_F(nyears * nages, 0); |
| 19 | 3240x |
for (int fleet_index = 0; fleet_index < population.nfleets; fleet_index++) |
| 20 |
{
|
|
| 21 | 2160x |
if(!population.fleets[fleet_index]->is_survey){
|
| 22 |
// Known values were used to generate "true" value and test CalculateMortality() |
|
| 23 | 1080x |
mortality_F[i_age_year] += population.fleets[fleet_index]->Fmort[year] * |
| 24 | 1080x |
population.fleets[fleet_index]->selectivity->evaluate(population.ages[age]); |
| 25 |
|
|
| 26 | 1080x |
EXPECT_EQ(population.mortality_F[i_age_year], mortality_F[i_age_year]); |
| 27 |
|
|
| 28 | ||
| 29 | 1080x |
std::vector<double> mortality_Z(nyears * nages, 0); |
| 30 | 2160x |
mortality_Z[i_age_year] = fims_math::exp(population.log_M[i_age_year]) + |
| 31 | 1080x |
mortality_F[i_age_year]; |
| 32 | 1080x |
EXPECT_EQ(population.mortality_Z[i_age_year], mortality_Z[i_age_year]); |
| 33 |
} |
|
| 34 |
} |
|
| 35 |
} |
|
| 36 |
} |
|
| 37 |
} |
|
| 38 | ||
| 39 | 28x |
TEST_F(PopulationEvaluateTestFixture, CalculateInitialNumbersAA_works) |
| 40 |
{
|
|
| 41 | ||
| 42 | 3x |
std::vector<double> numbers_at_age(nyears * nages, 0); |
| 43 | ||
| 44 | 93x |
for (int year = 0; year < population.nyears; year++) |
| 45 |
{
|
|
| 46 | 1170x |
for (int age = 0; age < population.nages; age++) |
| 47 |
{
|
|
| 48 | 1080x |
int i_age_year = year * population.nages + age; |
| 49 | ||
| 50 | 1080x |
population.CalculateInitialNumbersAA(i_age_year, age); |
| 51 | ||
| 52 | 1080x |
numbers_at_age[i_age_year] = fims_math::exp(population.log_init_naa[age]); |
| 53 | 1080x |
EXPECT_EQ(population.numbers_at_age[i_age_year], numbers_at_age[i_age_year]); |
| 54 |
} |
|
| 55 |
} |
|
| 56 |
} |
|
| 57 | ||
| 58 | 28x |
TEST_F(PopulationEvaluateTestFixture, CalculateUnfishedNumbersAAandUnfishedSpawningBiomass_works) |
| 59 |
{
|
|
| 60 | 3x |
std::vector<double> test_unfished_numbers_at_age((nyears + 1) * nages, 0); |
| 61 | 3x |
std::vector<double> test_unfished_spawning_biomass(nyears+1, 0); |
| 62 | ||
| 63 | 96x |
for (int year = 0; year < (population.nyears + 1); year++) |
| 64 |
{
|
|
| 65 | 1209x |
for (int age = 0; age < population.nages; age++) |
| 66 |
{
|
|
| 67 | 1116x |
int i_age_year = year * population.nages + age; |
| 68 |
|
|
| 69 | 1116x |
if (age == 0) |
| 70 |
{
|
|
| 71 | 93x |
population.unfished_numbers_at_age[i_age_year] = fims_math::exp(population.recruitment->log_rzero[0]); |
| 72 | 93x |
test_unfished_numbers_at_age[i_age_year] = fims_math::exp(population.recruitment->log_rzero[0]); |
| 73 |
} |
|
| 74 | ||
| 75 | 1116x |
if (year == 0 && age > 0){
|
| 76 |
|
|
| 77 |
// values from FIMS |
|
| 78 | 33x |
population.CalculateUnfishedNumbersAA(i_age_year, age-1, age); |
| 79 |
// true values from test |
|
| 80 | 33x |
test_unfished_numbers_at_age[i_age_year] = |
| 81 | 66x |
test_unfished_numbers_at_age[i_age_year-1] * |
| 82 | 33x |
fims_math::exp(-fims_math::exp(population.log_M[i_age_year-1])); |
| 83 | ||
| 84 |
} |
|
| 85 | ||
| 86 | 1116x |
if (year>0 && age > 0) |
| 87 |
{
|
|
| 88 | 990x |
int i_agem1_yearm1 = (year - 1) * population.nages + (age - 1); |
| 89 | 990x |
EXPECT_GT(population.M[i_agem1_yearm1], 0.0); |
| 90 |
// values from FIMS |
|
| 91 | 990x |
population.CalculateUnfishedNumbersAA(i_age_year, i_agem1_yearm1, age); |
| 92 |
// true values from test |
|
| 93 |
// unfished_numbers_at_age[i_age_year] = unfished_numbers_at_age[i_age_year-1] * fims_math::exp(-fims_math::exp(population.log_M[i_age_year-1])); |
|
| 94 | 990x |
test_unfished_numbers_at_age[i_age_year] = |
| 95 | 1980x |
test_unfished_numbers_at_age[i_agem1_yearm1] * |
| 96 | 990x |
fims_math::exp(-fims_math::exp(population.log_M[i_agem1_yearm1])); |
| 97 |
} |
|
| 98 | ||
| 99 | 1116x |
if(age==(population.nages-1)){
|
| 100 | 93x |
int i_agem1_yearm1 = 0; |
| 101 | 93x |
if(year == 0){
|
| 102 | 3x |
i_agem1_yearm1 = (age - 1); |
| 103 |
} else{
|
|
| 104 | 90x |
i_agem1_yearm1 = (year - 1) * population.nages + (age - 1); |
| 105 |
} |
|
| 106 | 93x |
test_unfished_numbers_at_age[i_age_year] = |
| 107 | 186x |
test_unfished_numbers_at_age[i_age_year] + |
| 108 | 93x |
test_unfished_numbers_at_age[i_agem1_yearm1 + 1] * |
| 109 | 93x |
fims_math::exp(-fims_math::exp(population.log_M[i_agem1_yearm1 + 1])); |
| 110 | ||
| 111 |
} |
|
| 112 | ||
| 113 | 1116x |
population.CalculateMaturityAA(i_age_year, age); |
| 114 | 1116x |
population.CalculateUnfishedSpawningBiomass(i_age_year, year, age); |
| 115 |
|
|
| 116 | 2232x |
test_unfished_spawning_biomass[year] += population.proportion_mature_at_age[i_age_year] * |
| 117 | 2232x |
population.proportion_female[age] * |
| 118 | 1116x |
test_unfished_numbers_at_age[i_age_year] * |
| 119 | 1116x |
population.growth->evaluate(population.ages[age]); |
| 120 | ||
| 121 | ||
| 122 | 1116x |
EXPECT_EQ(population.unfished_numbers_at_age[i_age_year], test_unfished_numbers_at_age[i_age_year]); |
| 123 | 1116x |
EXPECT_GT(population.unfished_numbers_at_age[i_age_year], 0.0); |
| 124 | ||
| 125 |
} |
|
| 126 |
|
|
| 127 | 93x |
EXPECT_EQ(population.unfished_spawning_biomass[year], test_unfished_spawning_biomass[year]); |
| 128 | 93x |
EXPECT_GT(population.unfished_spawning_biomass[year], 0.0); |
| 129 |
} |
|
| 130 |
} |
|
| 131 |
} |
| 1 |
#include "gtest/gtest.h" |
|
| 2 |
#include "population_dynamics/recruitment/functors/sr_beverton_holt.hpp" |
|
| 3 | ||
| 4 |
|
|
| 5 |
namespace |
|
| 6 |
{
|
|
| 7 | 22x |
TEST(SrBevertonHoltEvaluate, UseMultipleInputs) |
| 8 |
{
|
|
| 9 |
// BH_fcn(R0 = 1000, h = 0.75, phi0 = 0.1, x = 30): 837.2093 |
|
| 10 |
// BH_fcn(R0 = 1000, h = 0.99, phi0 = 0.1, x = 30): 994.1423 |
|
| 11 |
// BH_fcn(R0 = 1000, h = 0.75, phi0 = 0.3, x = 30): 679.2453 |
|
| 12 |
// BH_fcn(R0 = 1000, h = 0.99, phi0 = 0.3, x = 30): 985.8921 |
|
| 13 |
// BH_fcn(R0 = 1000, h = 0.2, phi0 = 0.2, x = 40): 200 |
|
| 14 |
// BH_fcn(R0 = 1000, h = 0.99, phi0 = 0.2, x = 40): 990 |
|
| 15 | ||
| 16 | 3x |
fims_popdy::SRBevertonHolt<double> recruit1; |
| 17 | 3x |
recruit1.logit_steep.resize(1); |
| 18 | 3x |
recruit1.logit_steep[0] = fims_math::logit(0.2, 1.0, 0.7500); |
| 19 |
// The R0 value (1 thousand) here is for this unit test. |
|
| 20 |
// It is different than the Model Comparison Project value (1 million). |
|
| 21 | 3x |
recruit1.log_rzero.resize(1); |
| 22 | 3x |
recruit1.log_rzero[0] = std::log(1000.000); |
| 23 | 3x |
double spawners = 30.000; |
| 24 | 3x |
double phi_0 = 0.1; |
| 25 |
// # R code that generates true values for testing |
|
| 26 |
// BH_fcn <- function(R0, h, phi0, x) {
|
|
| 27 |
// # R0 = unfished recruitment |
|
| 28 |
// # h = steepness |
|
| 29 |
// # phi0 = unfished spawners per recruit |
|
| 30 |
// # x = spawners |
|
| 31 |
// recruits <- (0.8 * R0 * h * x) / (0.2 * 100.0 * (1.0 - h) + x * (h // - 0.2)) |
|
| 32 |
// return(recruits) |
|
| 33 |
// } |
|
| 34 |
// (0.8 * 1000.0 * 0.75 * 30.0) / (0.2 * 100.0 * (1.0 - 0.75) + 30.0 * (0.75 - 0.2)) = 837.2093 |
|
| 35 | 3x |
double expect_recruit1 = 837.209300; |
| 36 | 3x |
EXPECT_NEAR(recruit1.evaluate(spawners,phi_0), expect_recruit1, 0.0001); |
| 37 | 3x |
EXPECT_EQ(recruit1.GetId(), 0); |
| 38 |
|
|
| 39 | 3x |
fims_popdy::SRBevertonHolt<double> recruit2; |
| 40 | 3x |
recruit2.logit_steep.resize(1); |
| 41 | 3x |
recruit2.logit_steep[0] = fims_math::logit(0.2, 1.0, 0.200); |
| 42 | 3x |
recruit2.log_rzero.resize(1); |
| 43 | 3x |
recruit2.log_rzero[0] = std::log(1000.000); |
| 44 | 3x |
double spawners2 = 40.000; |
| 45 | 3x |
double phi_02 = 0.2; |
| 46 |
// # R code that generates true values for testing |
|
| 47 |
// BH_fcn <- function(R0, h, phi0, x) {
|
|
| 48 |
// # R0 = unfished recruitment |
|
| 49 |
// # h = steepness |
|
| 50 |
// # phi0 = unfished spawners per recruit |
|
| 51 |
// # x = spawners |
|
| 52 |
// recruits <- (0.8 * R0 * h * x) / (0.2 * ssb0 * (1.0 - h) + x * (h // - 0.2)) |
|
| 53 |
// return(recruits) |
|
| 54 |
// } |
|
| 55 |
|
|
| 56 | 3x |
double expect_recruit2 = 200.0; |
| 57 | 3x |
EXPECT_NEAR(recruit2.evaluate(spawners2, phi_02), expect_recruit2, 0.0001); |
| 58 | 3x |
EXPECT_EQ(recruit2.GetId(), 1); |
| 59 |
} |
|
| 60 | ||
| 61 |
} |
| 1 |
/** |
|
| 2 |
* @file data_object.hpp |
|
| 3 |
* @brief TODO: provide a brief description. |
|
| 4 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 5 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 6 |
* folder for reuse information. |
|
| 7 |
*/ |
|
| 8 |
#ifndef FIMS_COMMON_DATA_OBJECT_HPP |
|
| 9 |
#define FIMS_COMMON_DATA_OBJECT_HPP |
|
| 10 | ||
| 11 |
#include <exception> |
|
| 12 |
#include <vector> |
|
| 13 | ||
| 14 |
#include "model_object.hpp" |
|
| 15 |
#include "fims_vector.hpp" |
|
| 16 | ||
| 17 |
namespace fims_data_object {
|
|
| 18 | ||
| 19 |
/** |
|
| 20 |
* Container to hold user supplied data. |
|
| 21 |
*/ |
|
| 22 |
template <typename Type> |
|
| 23 |
struct DataObject : public fims_model_object::FIMSObject<Type> {
|
|
| 24 |
static uint32_t id_g; /**< id of the Data Object >*/ |
|
| 25 |
fims::Vector<Type> data; /**< vector of the data >*/ |
|
| 26 |
size_t dimensions; /**< dimension of the Data object >*/ |
|
| 27 |
size_t imax; /**<1st dimension of data object >*/ |
|
| 28 |
size_t jmax; /**< 2nd dimension of data object>*/ |
|
| 29 |
size_t kmax; /**< 3rd dimension of data object>*/ |
|
| 30 |
size_t lmax; /**< 4th dimension of data object>*/ |
|
| 31 | ! |
Type na_value = -999; /**< specifying the NA value >*/ |
| 32 | ||
| 33 |
/** |
|
| 34 |
* Constructs a one-dimensional data object. |
|
| 35 |
*/ |
|
| 36 | ! |
DataObject(size_t imax) : dimensions(1), imax(imax) {
|
| 37 | ! |
data.resize(imax); |
| 38 | ||
| 39 | ! |
this->id = DataObject<Type>::id_g++; |
| 40 |
} |
|
| 41 | ||
| 42 |
/** |
|
| 43 |
* Constructs a two-dimensional data object. |
|
| 44 |
*/ |
|
| 45 | ! |
DataObject(size_t imax, size_t jmax) : dimensions(2), imax(imax), jmax(jmax) {
|
| 46 | ! |
data.resize(imax * jmax); |
| 47 | ! |
this->id = DataObject<Type>::id_g++; |
| 48 |
} |
|
| 49 | ||
| 50 |
/** |
|
| 51 |
* Constructs a three-dimensional data object. |
|
| 52 |
*/ |
|
| 53 |
DataObject(size_t imax, size_t jmax, size_t kmax) |
|
| 54 |
: dimensions(3), imax(imax), jmax(jmax), kmax(kmax) {
|
|
| 55 |
data.resize(imax * jmax * kmax); |
|
| 56 |
this->id = DataObject<Type>::id_g++; |
|
| 57 |
} |
|
| 58 | ||
| 59 |
/** |
|
| 60 |
* Constructs a four-dimensional data object. |
|
| 61 |
*/ |
|
| 62 |
DataObject(size_t imax, size_t jmax, size_t kmax, size_t lmax) |
|
| 63 |
: dimensions(4), imax(imax), jmax(jmax), kmax(kmax), lmax(lmax) {
|
|
| 64 |
data.resize(imax * jmax * kmax * lmax); |
|
| 65 |
this->id = DataObject<Type>::id_g++; |
|
| 66 |
} |
|
| 67 | ||
| 68 |
/** |
|
| 69 |
* Retrieve element from 1d data set. |
|
| 70 |
* @param i dimension of 1d data set |
|
| 71 |
* @return the value of the vector at position i |
|
| 72 |
*/ |
|
| 73 |
inline Type operator()(size_t i) { return data[i]; }
|
|
| 74 | ||
| 75 |
/** |
|
| 76 |
* Retrieve element from 1d data set. |
|
| 77 |
* Throws an exception if index is out of bounds. |
|
| 78 |
* @param i dimension of 1d data set |
|
| 79 |
* @return the reference to the value of the vector at position i |
|
| 80 |
*/ |
|
| 81 | ! |
inline Type& at(size_t i) {
|
| 82 | ! |
if (i >= this->data.size()) {
|
| 83 | ! |
throw std::overflow_error("DataObject error:i index out of bounds");
|
| 84 |
} |
|
| 85 | ! |
return data[i]; |
| 86 |
} |
|
| 87 | ||
| 88 |
/** |
|
| 89 |
* Retrieve element from 2d data set. |
|
| 90 |
* @param i 1st dimension of 2d data set |
|
| 91 |
* @param j 2nd dimension of 2d data set |
|
| 92 |
* @return the value of the matrix at position i, j |
|
| 93 |
*/ |
|
| 94 |
inline const Type operator()(size_t i, size_t j) {
|
|
| 95 |
return data[i * jmax + j]; |
|
| 96 |
} |
|
| 97 | ||
| 98 |
/** |
|
| 99 |
* Retrieve element from 2d data set. |
|
| 100 |
* Throws an exception if index is out of bounds. |
|
| 101 |
* @param i 1st dimension of 2d data set |
|
| 102 |
* @param j 2nd dimension of 2d data set |
|
| 103 |
* @return the reference to the value of the matrix at position i, j |
|
| 104 |
*/ |
|
| 105 | ! |
inline Type& at(size_t i, size_t j) {
|
| 106 | ! |
if ((i * jmax + j) >= this->data.size()) {
|
| 107 | ! |
throw std::overflow_error("DataObject error: index out of bounds");
|
| 108 |
} |
|
| 109 | ! |
return data[i * jmax + j]; |
| 110 |
} |
|
| 111 | ||
| 112 |
/** |
|
| 113 |
* Retrieve element from 3d data set. |
|
| 114 |
* @param i 1st dimension of 3d data set |
|
| 115 |
* @param j 2nd dimension of 3d data set |
|
| 116 |
* @param k 3rd dimension of 3d data set |
|
| 117 |
* @return the value of the array at position i, j, k |
|
| 118 |
*/ |
|
| 119 |
inline const Type operator()(size_t i, size_t j, size_t k) {
|
|
| 120 |
return data[i * jmax * kmax + j * kmax + k]; |
|
| 121 |
} |
|
| 122 | ||
| 123 |
/** |
|
| 124 |
* Retrieve element from 3d data set. |
|
| 125 |
* Throws an exception if index is out of bounds. |
|
| 126 |
* @param i 1st dimension of 3d data set |
|
| 127 |
* @param j 2nd dimension of 3d data set |
|
| 128 |
* @param k 3rd dimension of 3d data set |
|
| 129 |
* @return the reference to the value of the array at position i, j, k |
|
| 130 |
*/ |
|
| 131 |
inline Type& at(size_t i, size_t j, size_t k) {
|
|
| 132 |
if ((i * jmax * kmax + j * kmax + k) >= this->data.size()) {
|
|
| 133 |
throw std::overflow_error("DataObject error: index out of bounds");
|
|
| 134 |
} |
|
| 135 |
return data[i * jmax * kmax + j * kmax + k]; |
|
| 136 |
} |
|
| 137 | ||
| 138 |
/** |
|
| 139 |
* Retrieve element from 4d data set. |
|
| 140 |
* @param i 1st dimension of 4d data set |
|
| 141 |
* @param j 2nd dimension of 4d data set |
|
| 142 |
* @param k 3rd dimension of 4d data set |
|
| 143 |
* @param l 4th dimension of 4d data set |
|
| 144 |
* @return the value of the array at position i, j, k, l |
|
| 145 |
*/ |
|
| 146 |
inline const Type operator()(size_t i, size_t j, size_t k, size_t l) {
|
|
| 147 |
return data[i * jmax * kmax * lmax + j * kmax * lmax + k * lmax + l]; |
|
| 148 |
} |
|
| 149 | ||
| 150 |
/** |
|
| 151 |
* Retrieve element from 3d data set. |
|
| 152 |
* Throws an exception if index is out of bounds. |
|
| 153 |
* @param i 1st dimension of 4d data set |
|
| 154 |
* @param j 2nd dimension of 4d data set |
|
| 155 |
* @param k 3rd dimension of 4d data set |
|
| 156 |
* @param l 4th dimension of 4d data set |
|
| 157 |
* @return the reference to the value of the array at position i, j, k, l |
|
| 158 |
*/ |
|
| 159 |
inline Type& at(size_t i, size_t j, size_t k, size_t l) {
|
|
| 160 |
if ((i * jmax * kmax * lmax + j * kmax * lmax + k * lmax + l) >= |
|
| 161 |
this->data.size()) {
|
|
| 162 |
throw std::overflow_error("DataObject error: index out of bounds");
|
|
| 163 |
} |
|
| 164 |
return data[i * jmax * kmax * lmax + j * kmax * lmax + k * lmax + l]; |
|
| 165 |
} |
|
| 166 | ||
| 167 |
/** |
|
| 168 |
* @brief Get the dimensions object |
|
| 169 |
* |
|
| 170 |
* @return size_t |
|
| 171 |
*/ |
|
| 172 |
size_t get_dimensions() const { return dimensions; }
|
|
| 173 | ||
| 174 |
/** |
|
| 175 |
* @brief Get the imax object |
|
| 176 |
* |
|
| 177 |
* @return size_t |
|
| 178 |
*/ |
|
| 179 | ! |
size_t get_imax() const { return imax; }
|
| 180 | ||
| 181 |
/** |
|
| 182 |
* @brief Get the jmax object |
|
| 183 |
* |
|
| 184 |
* @return size_t |
|
| 185 |
*/ |
|
| 186 | ! |
size_t get_jmax() const { return jmax; }
|
| 187 | ||
| 188 |
/** |
|
| 189 |
* @brief Get the kmax object |
|
| 190 |
* |
|
| 191 |
* @return size_t |
|
| 192 |
*/ |
|
| 193 |
size_t get_kmax() const { return kmax; }
|
|
| 194 | ||
| 195 |
/** |
|
| 196 |
* @brief Get the lmax object |
|
| 197 |
* |
|
| 198 |
* @return size_t |
|
| 199 |
*/ |
|
| 200 |
size_t get_lmax() const { return lmax; }
|
|
| 201 |
}; |
|
| 202 | ||
| 203 |
template <typename Type> |
|
| 204 |
uint32_t DataObject<Type>::id_g = 0; |
|
| 205 | ||
| 206 |
} // namespace fims_data_object |
|
| 207 | ||
| 208 |
#endif |
| 1 |
/** |
|
| 2 |
* @file information.hpp |
|
| 3 |
* @brief TODO: provide a brief description. |
|
| 4 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 5 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 6 |
* folder for reuse information. |
|
| 7 |
*/ |
|
| 8 | ||
| 9 |
#ifndef FIMS_COMMON_INFORMATION_HPP |
|
| 10 |
#define FIMS_COMMON_INFORMATION_HPP |
|
| 11 | ||
| 12 |
#include <map> |
|
| 13 |
#include <memory> |
|
| 14 |
#include <vector> |
|
| 15 |
#include <algorithm> |
|
| 16 | ||
| 17 |
#include "../distributions/distributions.hpp" |
|
| 18 |
#include "../population_dynamics/fleet/fleet.hpp" |
|
| 19 |
#include "../population_dynamics/growth/growth.hpp" |
|
| 20 |
#include "../population_dynamics/population/population.hpp" |
|
| 21 |
#include "../population_dynamics/recruitment/recruitment.hpp" |
|
| 22 |
#include "../population_dynamics/selectivity/selectivity.hpp" |
|
| 23 |
#include "def.hpp" |
|
| 24 |
#include "fims_vector.hpp" |
|
| 25 |
#include "model_object.hpp" |
|
| 26 | ||
| 27 |
namespace fims_info {
|
|
| 28 | ||
| 29 |
/** |
|
| 30 |
* @brief Stores FIMS model information and creates model. Contains all objects |
|
| 31 |
* and data pre-model construction |
|
| 32 |
*/ |
|
| 33 |
template <typename Type> |
|
| 34 |
class Information {
|
|
| 35 |
public: |
|
| 36 | ! |
size_t nyears = 0; /**< number of years >*/ |
| 37 | ! |
size_t nseasons = 1; /**< number of seasons >*/ |
| 38 | ! |
size_t nages = 0; /**< number of ages>*/ |
| 39 | ||
| 40 |
static std::shared_ptr<Information<Type> > |
|
| 41 |
fims_information; /**< singleton instance >*/ |
|
| 42 |
std::vector<Type*> parameters; /**< list of all estimated parameters >*/ |
|
| 43 |
std::vector<Type*> |
|
| 44 |
random_effects_parameters; /**< list of all random effects parameters >*/ |
|
| 45 |
std::vector<Type*> |
|
| 46 |
fixed_effects_parameters; /**< list of all fixed effects parameters >*/ |
|
| 47 |
std::vector<std::string> |
|
| 48 |
parameter_names; /**< list of all parameter names estimated in the model */ |
|
| 49 | ||
| 50 |
// data objects |
|
| 51 |
std::map<uint32_t, std::shared_ptr<fims_data_object::DataObject<Type> > > |
|
| 52 |
data_objects; /**< map that holds data objects >*/ |
|
| 53 |
typedef typename std::map< |
|
| 54 |
uint32_t, std::shared_ptr<fims_data_object::DataObject<Type> > >::iterator |
|
| 55 |
data_iterator; /**< iterator for the data objects */ |
|
| 56 | ||
| 57 |
// life history modules |
|
| 58 |
std::map<uint32_t, std::shared_ptr<fims_popdy::RecruitmentBase<Type> > > |
|
| 59 |
recruitment_models; /**<hash map to link each object to its shared |
|
| 60 |
location in memory*/ |
|
| 61 |
typedef typename std::map< |
|
| 62 |
uint32_t, std::shared_ptr<fims_popdy::RecruitmentBase<Type> > >::iterator |
|
| 63 |
recruitment_models_iterator; |
|
| 64 |
/**< iterator for recruitment objects>*/ |
|
| 65 | ||
| 66 |
std::map<uint32_t, std::shared_ptr<fims_popdy::SelectivityBase<Type> > > |
|
| 67 |
selectivity_models; /**<hash map to link each object to its shared |
|
| 68 |
location in memory*/ |
|
| 69 |
typedef typename std::map< |
|
| 70 |
uint32_t, std::shared_ptr<fims_popdy::SelectivityBase<Type> > >::iterator |
|
| 71 |
selectivity_models_iterator; |
|
| 72 |
/**< iterator for selectivity objects>*/ |
|
| 73 | ||
| 74 |
std::map<uint32_t, std::shared_ptr<fims_popdy::GrowthBase<Type> > > |
|
| 75 |
growth_models; /**<hash map to link each object to its shared location in |
|
| 76 |
memory*/ |
|
| 77 |
typedef typename std::map< |
|
| 78 |
uint32_t, std::shared_ptr<fims_popdy::GrowthBase<Type> > >::iterator |
|
| 79 |
growth_models_iterator; |
|
| 80 |
/**< iterator for growth objects>*/ |
|
| 81 | ||
| 82 |
std::map<uint32_t, std::shared_ptr<fims_popdy::MaturityBase<Type> > > |
|
| 83 |
maturity_models; /**<hash map to link each object to its shared location |
|
| 84 |
in memory*/ |
|
| 85 |
typedef typename std::map< |
|
| 86 |
uint32_t, std::shared_ptr<fims_popdy::MaturityBase<Type> > >::iterator |
|
| 87 |
maturity_models_iterator; |
|
| 88 |
/**< iterator for maturity objects>*/ |
|
| 89 | ||
| 90 |
// fleet modules |
|
| 91 |
std::map<uint32_t, std::shared_ptr<fims_popdy::Fleet<Type> > > |
|
| 92 |
fleets; /**<hash map to link each object to its shared location in |
|
| 93 |
memory*/ |
|
| 94 |
typedef |
|
| 95 |
typename std::map<uint32_t, |
|
| 96 |
std::shared_ptr<fims_popdy::Fleet<Type> > >::iterator |
|
| 97 |
fleet_iterator; |
|
| 98 |
/**< iterator for fleet objects>*/ |
|
| 99 | ||
| 100 |
// populations |
|
| 101 |
std::map<uint32_t, std::shared_ptr<fims_popdy::Population<Type> > > |
|
| 102 |
populations; /**<hash map to link each object to its shared location in |
|
| 103 |
memory*/ |
|
| 104 |
typedef typename std::map< |
|
| 105 |
uint32_t, std::shared_ptr<fims_popdy::Population<Type> > >::iterator |
|
| 106 |
population_iterator; |
|
| 107 |
/**< iterator for population objects>*/ |
|
| 108 | ||
| 109 |
// distributions |
|
| 110 |
std::map<uint32_t, |
|
| 111 |
std::shared_ptr<fims_distributions::DensityComponentBase<Type> > > |
|
| 112 |
density_components; /**<hash map to link each object to its shared |
|
| 113 |
location in memory*/ |
|
| 114 |
typedef typename std::map< |
|
| 115 |
uint32_t, |
|
| 116 |
std::shared_ptr<fims_distributions::DensityComponentBase<Type> > >::iterator |
|
| 117 |
density_components_iterator; |
|
| 118 |
/**< iterator for distribution objects>*/ |
|
| 119 | ||
| 120 |
std::unordered_map<uint32_t, fims::Vector<Type>* > |
|
| 121 |
variable_map; /**<hash map to link a parameter, derived value, or observation |
|
| 122 |
to its shared location in memory */ |
|
| 123 |
typedef typename std::unordered_map<uint32_t, fims::Vector<Type>* >::iterator |
|
| 124 |
variable_map_iterator; /**< iterator for variable map>*/ |
|
| 125 | ||
| 126 | ! |
Information() {
|
| 127 |
} |
|
| 128 | ||
| 129 | ! |
virtual ~Information() {
|
| 130 |
} |
|
| 131 |
|
|
| 132 |
/** |
|
| 133 |
* @brief Clears all containers. |
|
| 134 |
* |
|
| 135 |
*/ |
|
| 136 | ! |
void Clear(){
|
| 137 | ! |
this->data_objects.clear(); |
| 138 | ! |
this->density_components.clear(); |
| 139 | ! |
this->fixed_effects_parameters.clear(); |
| 140 | ! |
this->fleets.clear(); |
| 141 | ! |
this->growth_models.clear(); |
| 142 | ! |
this->maturity_models.clear(); |
| 143 | ! |
this->parameter_names.clear(); |
| 144 | ! |
this->parameters.clear(); |
| 145 | ! |
this->random_effects_parameters.clear(); |
| 146 | ! |
this->recruitment_models.clear(); |
| 147 | ! |
this->selectivity_models.clear(); |
| 148 | ! |
this->variable_map.clear(); |
| 149 | ! |
this->nyears = 0; |
| 150 | ! |
this->nseasons = 0; |
| 151 | ! |
this->nages = 0; |
| 152 |
} |
|
| 153 | ||
| 154 |
/** |
|
| 155 |
* @brief Returns a singleton Information object for type T. |
|
| 156 |
* |
|
| 157 |
* @return singleton for type T |
|
| 158 |
*/ |
|
| 159 | ! |
static std::shared_ptr<Information<Type> > GetInstance() {
|
| 160 | ! |
if (Information<Type>::fims_information == nullptr) {
|
| 161 | ! |
Information<Type>::fims_information = |
| 162 | ! |
std::make_shared<fims_info::Information<Type> >(); |
| 163 |
} |
|
| 164 | ! |
return Information<Type>::fims_information; |
| 165 |
} |
|
| 166 | ||
| 167 |
/** |
|
| 168 |
* @brief Register a parameter as estimable. |
|
| 169 |
* |
|
| 170 |
* @param p |
|
| 171 |
*/ |
|
| 172 | ! |
void RegisterParameter(Type& p) {
|
| 173 | ! |
this->fixed_effects_parameters.push_back(&p); |
| 174 |
} |
|
| 175 | ||
| 176 |
/** |
|
| 177 |
* @brief Register a random effect as estimable. |
|
| 178 |
* |
|
| 179 |
* @param re |
|
| 180 |
*/ |
|
| 181 | ! |
void RegisterRandomEffect(Type& re) {
|
| 182 | ! |
this->random_effects_parameters.push_back(&re); |
| 183 |
} |
|
| 184 | ||
| 185 |
/** |
|
| 186 |
* @brief Register a parameter name. |
|
| 187 |
* |
|
| 188 |
* @param p_name |
|
| 189 |
*/ |
|
| 190 | ! |
void RegisterParameterName(std::string p_name) {
|
| 191 | ! |
this->parameter_names.push_back(p_name); |
| 192 |
} |
|
| 193 | ||
| 194 |
/** |
|
| 195 |
* @brief Loop over distributions and set links to distribution x value if distribution is a prior type. |
|
| 196 |
*/ |
|
| 197 | ! |
void SetupPriors() {
|
| 198 | ! |
for (density_components_iterator it = density_components.begin(); it != density_components.end(); ++it) {
|
| 199 | ! |
std::shared_ptr<fims_distributions::DensityComponentBase<Type> > d = (*it).second; |
| 200 | ! |
if (d->input_type == "prior") {
|
| 201 | ! |
FIMS_INFO_LOG("Setup prior for distribution " + fims::to_string(d->id));
|
| 202 | ! |
variable_map_iterator vmit; |
| 203 | ! |
FIMS_INFO_LOG("Link prior from distribution " + fims::to_string(d->id) + " to parameter " + fims::to_string(d->key[0]));
|
| 204 | ! |
vmit = this->variable_map.find(d->key[0]); |
| 205 | ! |
d->x = *(*vmit).second; |
| 206 | ! |
for (size_t i = 1; i < d->key.size(); i++) {
|
| 207 | ! |
FIMS_INFO_LOG("Link prior from distribution " + fims::to_string(d->id)
|
| 208 |
+ " to parameter " + fims::to_string(d->key[0])); |
|
| 209 | ! |
vmit = this->variable_map.find(d->key[i]); |
| 210 | ! |
d->x.insert(std::end(d->x), |
| 211 | ! |
std::begin(*(*vmit).second), std::end(*(*vmit).second)); |
| 212 |
} |
|
| 213 | ! |
FIMS_INFO_LOG("Prior size for distribution " + fims::to_string(d->id) + "is: " + fims::to_string(d->x.size()));
|
| 214 |
} |
|
| 215 |
} |
|
| 216 |
} |
|
| 217 | ||
| 218 |
/** |
|
| 219 |
* @brief Loop over distributions and set links to distribution x value if distribution is a random effects type. |
|
| 220 |
*/ |
|
| 221 | ! |
void SetupRandomEffects() {
|
| 222 | ! |
for (density_components_iterator it = this->density_components.begin(); it != this->density_components.end(); ++it) {
|
| 223 | ! |
std::shared_ptr<fims_distributions::DensityComponentBase<Type> > d = (*it).second; |
| 224 | ! |
if (d->input_type == "random_effects") {
|
| 225 | ! |
FIMS_INFO_LOG("Setup random effects for distribution " + fims::to_string(d->id));
|
| 226 | ! |
variable_map_iterator vmit; |
| 227 | ! |
FIMS_INFO_LOG("Link random effects from distribution "
|
| 228 |
+ fims::to_string(d->id) + " to derived value " + fims::to_string(d->key[0])); |
|
| 229 | ! |
vmit = this->variable_map.find(d->key[0]); |
| 230 | ! |
d->x = *(*vmit).second; |
| 231 | ! |
for (size_t i = 1; i < d->key.size(); i++) {
|
| 232 | ! |
FIMS_INFO_LOG("Link random effects from distribution " + fims::to_string(d->id)
|
| 233 |
+ " to derived value " + fims::to_string(d->key[0])); |
|
| 234 | ! |
vmit = this->variable_map.find(d->key[i]); |
| 235 | ! |
d->x.insert(std::end(d->x), |
| 236 | ! |
std::begin(*(*vmit).second), std::end(*(*vmit).second)); |
| 237 |
} |
|
| 238 | ! |
FIMS_INFO_LOG("Random effect size for distribution " + fims::to_string(d->id) + " is: " + fims::to_string(d->x.size()));
|
| 239 |
} |
|
| 240 |
} |
|
| 241 |
} |
|
| 242 | ||
| 243 |
/** |
|
| 244 |
* @brief Loop over distributions and set links to distribution expected value if distribution is a data type. |
|
| 245 |
*/ |
|
| 246 | ! |
void SetupData() {
|
| 247 | ! |
for (density_components_iterator it = this->density_components.begin(); it != this->density_components.end(); ++it) {
|
| 248 | ! |
std::shared_ptr<fims_distributions::DensityComponentBase<Type> > d = (*it).second; |
| 249 | ! |
if (d->input_type == "data") {
|
| 250 | ! |
FIMS_INFO_LOG("Setup expected value for data distribution " + fims::to_string(d->id));
|
| 251 | ! |
variable_map_iterator vmit; |
| 252 | ! |
FIMS_INFO_LOG("Link expected value from distribution " + fims::to_string(d->id)
|
| 253 |
+ " to derived value " + fims::to_string(d->key[0])); |
|
| 254 | ! |
vmit = this->variable_map.find(d->key[0]); |
| 255 | ! |
d->expected_values = *(*vmit).second; |
| 256 | ||
| 257 | ! |
for (size_t i = 1; i < d->key.size(); i++) {
|
| 258 | ! |
vmit = this->variable_map.find(d->key[i]); |
| 259 | ! |
FIMS_INFO_LOG("Link expected value from distribution "
|
| 260 |
+ fims::to_string(d->id) + " to derived value " + fims::to_string(d->key[i])); |
|
| 261 | ! |
d->expected_values.insert(std::end(d->expected_values), |
| 262 | ! |
std::begin(*(*vmit).second), std::end(*(*vmit).second)); |
| 263 |
} |
|
| 264 | ! |
FIMS_INFO_LOG("Expected value size for distribution " + fims::to_string(d->id)
|
| 265 |
+ " is: " + fims::to_string(d->expected_values.size())); |
|
| 266 |
} |
|
| 267 |
} |
|
| 268 |
} |
|
| 269 | ||
| 270 |
/** |
|
| 271 |
* @brief Set pointers to index data in the fleet module. |
|
| 272 |
* |
|
| 273 |
* @param &valid_model reference to true/false boolean indicating whether model is valid. |
|
| 274 |
* @param f shared pointer to fleet module |
|
| 275 |
*/ |
|
| 276 | ! |
void SetFleetIndexData( |
| 277 |
bool &valid_model, |
|
| 278 |
std::shared_ptr<fims_popdy::Fleet<Type> > f) {
|
|
| 279 | ! |
if (f->fleet_observed_index_data_id_m != -999) {
|
| 280 | ! |
uint32_t observed_index_id = |
| 281 | ! |
static_cast<uint32_t> (f->fleet_observed_index_data_id_m); |
| 282 | ! |
data_iterator it = this->data_objects.find(observed_index_id); |
| 283 | ! |
if (it != this->data_objects.end()) {
|
| 284 | ! |
f->observed_index_data = (*it).second; |
| 285 | ! |
FIMS_INFO_LOG("Index data for fleet "
|
| 286 |
+ fims::to_string(f->id) + " successfully set to " |
|
| 287 |
+ fims::to_string(f->observed_index_data->at(1))); |
|
| 288 |
} else {
|
|
| 289 | ! |
valid_model = false; |
| 290 | ! |
FIMS_ERROR_LOG("Expected index data not defined for fleet "
|
| 291 |
+ fims::to_string(f->id) + ", index " |
|
| 292 |
+ fims::to_string(observed_index_id)); |
|
| 293 |
} |
|
| 294 |
} else {
|
|
| 295 | ! |
valid_model = false; |
| 296 |
// TODO: explore why index data is required because it should not be |
|
| 297 | ! |
FIMS_ERROR_LOG("No index data observed for fleet "
|
| 298 |
+ fims::to_string(f->id) + ". FIMS requires index data for all fleets."); |
|
| 299 |
} |
|
| 300 |
} |
|
| 301 | ||
| 302 |
/** |
|
| 303 |
* @brief Set pointers to age composition data in the fleet module. |
|
| 304 |
* |
|
| 305 |
* @param &valid_model reference to true/false boolean indicating whether model is valid. |
|
| 306 |
* @param f shared pointer to fleet module |
|
| 307 |
*/ |
|
| 308 | ! |
void SetAgeCompositionData( |
| 309 |
bool &valid_model, |
|
| 310 |
std::shared_ptr<fims_popdy::Fleet<Type> > f) {
|
|
| 311 | ! |
if (f->fleet_observed_agecomp_data_id_m != -999) {
|
| 312 | ! |
uint32_t observed_agecomp_id = |
| 313 | ! |
static_cast<uint32_t> (f->fleet_observed_agecomp_data_id_m); |
| 314 | ! |
data_iterator it = this->data_objects.find(observed_agecomp_id); |
| 315 | ! |
if (it != this->data_objects.end()) {
|
| 316 | ! |
f->observed_agecomp_data = (*it).second; |
| 317 | ! |
FIMS_INFO_LOG("Observed input age-composition data for fleet "
|
| 318 |
+ fims::to_string(f->id) + " successfully set to " |
|
| 319 |
+ fims::to_string(f->observed_agecomp_data->at(1))); |
|
| 320 |
} else {
|
|
| 321 | ! |
valid_model = false; |
| 322 | ! |
FIMS_ERROR_LOG("Expected age-composition observations not defined for fleet "
|
| 323 |
+ fims::to_string(f->id)); |
|
| 324 |
} |
|
| 325 |
} |
|
| 326 |
} |
|
| 327 | ||
| 328 |
/** |
|
| 329 |
* @brief Set pointers to length composition data in the fleet module. |
|
| 330 |
* |
|
| 331 |
* @param &valid_model reference to true/false boolean indicating whether model is valid. |
|
| 332 |
* @param f shared pointer to fleet module |
|
| 333 |
*/ |
|
| 334 | ! |
void SetLengthCompositionData( |
| 335 |
bool &valid_model, |
|
| 336 |
std::shared_ptr<fims_popdy::Fleet<Type> > f) {
|
|
| 337 | ! |
if (f->fleet_observed_lengthcomp_data_id_m != -999) {
|
| 338 | ! |
uint32_t observed_lengthcomp_id = |
| 339 | ! |
static_cast<uint32_t> (f->fleet_observed_lengthcomp_data_id_m); |
| 340 | ! |
data_iterator it = this->data_objects.find(observed_lengthcomp_id); |
| 341 | ! |
if (it != this->data_objects.end()) {
|
| 342 | ! |
f->observed_lengthcomp_data = (*it).second; |
| 343 | ! |
FIMS_INFO_LOG("Observed input length-composition data for fleet "
|
| 344 |
+ fims::to_string(f->id) + " successfully set to " |
|
| 345 |
+ fims::to_string(f->observed_lengthcomp_data->at(1))); |
|
| 346 |
} else {
|
|
| 347 | ! |
valid_model = false; |
| 348 | ! |
FIMS_ERROR_LOG("Expected length-composition observations not defined for fleet "
|
| 349 |
+ fims::to_string(f->id)); |
|
| 350 |
} |
|
| 351 |
} |
|
| 352 |
} |
|
| 353 | ||
| 354 |
/** |
|
| 355 |
* @brief Set pointers to the selectivity module referenced in the fleet module. |
|
| 356 |
* |
|
| 357 |
* @param &valid_model reference to true/false boolean indicating whether model is valid. |
|
| 358 |
* @param f shared pointer to fleet module |
|
| 359 |
*/ |
|
| 360 | ! |
void SetFleetSelectivityModel( |
| 361 |
bool &valid_model, |
|
| 362 |
std::shared_ptr<fims_popdy::Fleet<Type> > f) {
|
|
| 363 | ! |
if (f->fleet_selectivity_id_m != -999) {
|
| 364 | ! |
uint32_t sel_id = static_cast<uint32_t> ( |
| 365 | ! |
f->fleet_selectivity_id_m); // cast as unsigned integer |
| 366 | ! |
selectivity_models_iterator it = this->selectivity_models.find( |
| 367 |
sel_id); // if find, set it, otherwise invalid |
|
| 368 | ||
| 369 | ! |
if (it != this->selectivity_models.end()) {
|
| 370 | ! |
f->selectivity = (*it).second; // elements in container held in pair |
| 371 | ! |
FIMS_INFO_LOG("Selectivity model "
|
| 372 |
+ fims::to_string(f->fleet_selectivity_id_m) |
|
| 373 |
+ " successfully set to fleet " + fims::to_string(f->id)); |
|
| 374 | ||
| 375 |
} else {
|
|
| 376 | ! |
valid_model = false; |
| 377 | ! |
FIMS_ERROR_LOG("Expected selectivity pattern not defined for fleet "
|
| 378 |
+ fims::to_string(f->id) + ", selectivity pattern " + fims::to_string(sel_id)); |
|
| 379 |
} |
|
| 380 | ||
| 381 |
} else {
|
|
| 382 | ! |
valid_model = false; |
| 383 | ! |
FIMS_ERROR_LOG("Error: No selectivity pattern defined for fleet " + fims::to_string(f->id)
|
| 384 |
+ ". FIMS requires selectivity be defined for all fleets."); |
|
| 385 |
} |
|
| 386 |
} |
|
| 387 | ||
| 388 |
/** |
|
| 389 |
* @brief Set pointers to the recruitment module referened in the population module. |
|
| 390 |
* |
|
| 391 |
* @param &valid_model reference to true/false boolean indicating whether model is valid. |
|
| 392 |
* @param p shared pointer to population module |
|
| 393 |
*/ |
|
| 394 | ! |
void SetRecruitment( |
| 395 |
bool &valid_model, |
|
| 396 |
std::shared_ptr<fims_popdy::Population<Type> > p) {
|
|
| 397 | ! |
if (p->recruitment_id != -999) {
|
| 398 | ! |
uint32_t recruitment_uint = static_cast<uint32_t> (p->recruitment_id); |
| 399 |
recruitment_models_iterator it = |
|
| 400 | ! |
this->recruitment_models.find(recruitment_uint); |
| 401 | ||
| 402 | ! |
if (it != this->recruitment_models.end()) {
|
| 403 | ! |
p->recruitment = |
| 404 | ! |
(*it).second; // recruitment defined in population.hpp |
| 405 | ! |
FIMS_INFO_LOG("Recruitment model "
|
| 406 |
+ fims::to_string(recruitment_uint) |
|
| 407 |
+ " successfully set to population " |
|
| 408 |
+ fims::to_string(p->id)); |
|
| 409 |
} else {
|
|
| 410 | ! |
valid_model = false; |
| 411 | ! |
FIMS_ERROR_LOG("Expected recruitment function not defined for "
|
| 412 |
"population " |
|
| 413 |
+ fims::to_string(p->id) + ", recruitment function " |
|
| 414 |
+ fims::to_string(recruitment_uint)); |
|
| 415 |
} |
|
| 416 | ||
| 417 |
} else {
|
|
| 418 | ! |
valid_model = false; |
| 419 | ! |
FIMS_ERROR_LOG("No recruitment function defined for population "
|
| 420 |
+ fims::to_string(p->id) |
|
| 421 |
+ ". FIMS requires recruitment functions be defined for all " |
|
| 422 |
"populations."); |
|
| 423 |
} |
|
| 424 |
} |
|
| 425 | ||
| 426 |
/** |
|
| 427 |
* @brief Set pointers to the growth module referened in the population module. |
|
| 428 |
* |
|
| 429 |
* @param &valid_model reference to true/false boolean indicating whether model is valid. |
|
| 430 |
* @param p shared pointer to population module |
|
| 431 |
*/ |
|
| 432 | ! |
void SetGrowth( |
| 433 |
bool &valid_model, |
|
| 434 |
std::shared_ptr<fims_popdy::Population<Type> > p) {
|
|
| 435 | ! |
if (p->growth_id != -999) {
|
| 436 | ! |
uint32_t growth_uint = static_cast<uint32_t> (p->growth_id); |
| 437 | ! |
growth_models_iterator it = this->growth_models.find( |
| 438 |
growth_uint); // growth_models is specified in information.hpp |
|
| 439 |
// and used in rcpp |
|
| 440 |
// at the head of information.hpp; are the |
|
| 441 |
// dimensions of ages defined in rcpp or where? |
|
| 442 | ! |
if (it != this->growth_models.end()) {
|
| 443 | ! |
p->growth = |
| 444 | ! |
(*it).second; // growth defined in population.hpp (the object |
| 445 |
// is called p, growth is within p) |
|
| 446 | ! |
FIMS_INFO_LOG("Growth model "
|
| 447 |
+ fims::to_string(growth_uint) |
|
| 448 |
+ " successfully set to population " + fims::to_string(p->id)); |
|
| 449 |
} else {
|
|
| 450 | ! |
valid_model = false; |
| 451 | ! |
FIMS_ERROR_LOG("Expected growth function not defined for population "
|
| 452 |
+ fims::to_string(p->id) + ", growth function " |
|
| 453 |
+ fims::to_string(growth_uint)); |
|
| 454 |
} |
|
| 455 | ||
| 456 |
} else {
|
|
| 457 | ! |
valid_model = false; |
| 458 | ! |
FIMS_ERROR_LOG("No growth function defined for population "
|
| 459 |
+ fims::to_string(p->id) |
|
| 460 |
+ ". FIMS requires growth functions be defined for all " |
|
| 461 |
"populations."); |
|
| 462 |
} |
|
| 463 |
} |
|
| 464 | ||
| 465 |
/** |
|
| 466 |
* @brief Set pointers to the maturity module referened in the population module. |
|
| 467 |
* |
|
| 468 |
* @param &valid_model reference to true/false boolean indicating whether model is valid. |
|
| 469 |
* @param p shared pointer to population module |
|
| 470 |
*/ |
|
| 471 | ! |
void SetMaturity( |
| 472 |
bool &valid_model, |
|
| 473 |
std::shared_ptr<fims_popdy::Population<Type> > p) {
|
|
| 474 | ! |
if (p->maturity_id != -999) {
|
| 475 | ! |
uint32_t maturity_uint = static_cast<uint32_t> (p->maturity_id); |
| 476 | ! |
maturity_models_iterator it = this->maturity_models.find( |
| 477 |
maturity_uint); // >maturity_models is specified in |
|
| 478 |
// information.hpp and used in rcpp |
|
| 479 | ! |
if (it != this->maturity_models.end()) {
|
| 480 | ! |
p->maturity = (*it).second; // >maturity defined in population.hpp |
| 481 | ! |
FIMS_INFO_LOG("Maturity model "
|
| 482 |
+ fims::to_string(maturity_uint) |
|
| 483 |
+ " successfully set to population " + fims::to_string(p->id)); |
|
| 484 |
} else {
|
|
| 485 | ! |
valid_model = false; |
| 486 | ! |
FIMS_ERROR_LOG("Expected maturity function not defined for population "
|
| 487 |
+ fims::to_string(p->id) + ", maturity function " |
|
| 488 |
+ fims::to_string(maturity_uint)); |
|
| 489 |
} |
|
| 490 |
} else {
|
|
| 491 | ||
| 492 | ! |
valid_model = false; |
| 493 | ! |
FIMS_ERROR_LOG("No maturity function defined for population "
|
| 494 |
+ fims::to_string(p->id) |
|
| 495 |
+ ". FIMS requires maturity functions be defined for all " |
|
| 496 |
"populations."); |
|
| 497 |
} |
|
| 498 |
} |
|
| 499 | ||
| 500 |
/** |
|
| 501 |
* @brief Loop over all fleets and set pointers to fleet objects |
|
| 502 |
* |
|
| 503 |
* @param &valid_model reference to true/false boolean indicating whether model is valid. |
|
| 504 |
*/ |
|
| 505 | ! |
void CreateFleetObjects(bool &valid_model) {
|
| 506 | ! |
for (fleet_iterator it = this->fleets.begin(); it != this->fleets.end(); |
| 507 | ! |
++it) {
|
| 508 | ||
| 509 | ! |
std::shared_ptr<fims_popdy::Fleet<Type> > f = (*it).second; |
| 510 | ! |
FIMS_INFO_LOG("Initializing fleet " + fims::to_string(f->id));
|
| 511 | ||
| 512 | ! |
f->Initialize(f->nyears, f->nages, f->nlengths); |
| 513 | ||
| 514 | ! |
SetFleetIndexData(valid_model, f); |
| 515 | ||
| 516 | ! |
SetAgeCompositionData(valid_model, f); |
| 517 | ||
| 518 | ! |
SetLengthCompositionData(valid_model, f); |
| 519 | ||
| 520 | ! |
SetFleetSelectivityModel(valid_model, f); |
| 521 |
} |
|
| 522 |
} |
|
| 523 | ||
| 524 |
/** |
|
| 525 |
* @brief Loop over all density components and set pointers to data objects |
|
| 526 |
* |
|
| 527 |
* @param &valid_model reference to true/false boolean indicating whether model is valid. |
|
| 528 |
*/ |
|
| 529 | ! |
void SetDataObjects(bool &valid_model) {
|
| 530 | ! |
for (density_components_iterator it = this->density_components.begin(); |
| 531 | ! |
it != this->density_components.end(); ++it) {
|
| 532 | ! |
std::shared_ptr<fims_distributions::DensityComponentBase<Type> > d = (*it).second; |
| 533 | ||
| 534 |
//set data objects if distribution is a data type |
|
| 535 | ! |
if (d->input_type == "data") {
|
| 536 | ! |
if (d->observed_data_id_m != -999) {
|
| 537 | ! |
uint32_t observed_data_id = static_cast<uint32_t> (d->observed_data_id_m); |
| 538 | ! |
data_iterator it = this->data_objects.find(observed_data_id); |
| 539 | ||
| 540 | ! |
if (it != this->data_objects.end()) {
|
| 541 | ! |
d->observed_values = (*it).second; |
| 542 | ! |
FIMS_INFO_LOG("Observed data "
|
| 543 |
+ fims::to_string(observed_data_id) |
|
| 544 |
+ " successfully set to density component " + fims::to_string(d->id)); |
|
| 545 |
} else {
|
|
| 546 | ! |
valid_model = false; |
| 547 | ! |
FIMS_ERROR_LOG("Expected data observations not defined for density component "
|
| 548 |
+ fims::to_string(d->id) + ", observed data " + fims::to_string(observed_data_id)); |
|
| 549 |
} |
|
| 550 | ||
| 551 |
} else {
|
|
| 552 | ! |
valid_model = false; |
| 553 | ! |
FIMS_ERROR_LOG("No data input for density component" + fims::to_string(d->id));
|
| 554 |
} |
|
| 555 |
} |
|
| 556 |
} |
|
| 557 | ||
| 558 |
} |
|
| 559 | ||
| 560 |
/** |
|
| 561 |
* @brief Loop over all populations and set pointers to population objects |
|
| 562 |
* |
|
| 563 |
* @param &valid_model reference to true/false boolean indicating whether model is valid. |
|
| 564 |
*/ |
|
| 565 | ! |
void CreatePopulationObjects(bool &valid_model) {
|
| 566 | ! |
for (population_iterator it = this->populations.begin(); |
| 567 | ! |
it != this->populations.end(); ++it) {
|
| 568 | ! |
std::shared_ptr<fims_popdy::Population<Type> > p = (*it).second; |
| 569 | ||
| 570 | ! |
FIMS_INFO_LOG("Initializing population " + fims::to_string(p->id));
|
| 571 |
// error check and set population elements |
|
| 572 |
// check me - add another fleet iterator to push information from |
|
| 573 | ! |
for (fleet_iterator it = this->fleets.begin(); it != this->fleets.end(); |
| 574 | ! |
++it) {
|
| 575 |
// Initialize fleet object |
|
| 576 | ! |
std::shared_ptr<fims_popdy::Fleet<Type> > f = (*it).second; |
| 577 |
// population to the individual fleets This is to pass catch at age |
|
| 578 |
// from population to fleets? |
|
| 579 |
// any shared member in p (population is pushed into fleets) |
|
| 580 | ! |
p->fleets.push_back(f); |
| 581 |
} |
|
| 582 | ||
| 583 | ! |
p->Initialize(p->nyears, p->nseasons, p->nages); |
| 584 | ||
| 585 |
//set information dimensions |
|
| 586 | ! |
this->nyears = std::max(this->nyears, p->nyears); |
| 587 | ! |
this->nages = std::max(this->nages, p->nages); |
| 588 | ! |
this->nseasons = std::max(this->nseasons, p->nseasons); |
| 589 | ||
| 590 | ! |
SetRecruitment(valid_model, p); |
| 591 | ||
| 592 | ! |
SetGrowth(valid_model, p); |
| 593 | ||
| 594 | ! |
SetMaturity(valid_model, p); |
| 595 | ||
| 596 |
} |
|
| 597 |
} |
|
| 598 | ||
| 599 |
/** |
|
| 600 |
* @brief Create the generalized stock assessment model that will evaluate the |
|
| 601 |
* objective function. Does error checking to make sure the program has |
|
| 602 |
* all necessary components for the model and that they're in the right |
|
| 603 |
* dimensions. This sets up pointers to all memory objects and initializes |
|
| 604 |
* fleet and population objects. |
|
| 605 |
* |
|
| 606 |
* @return True if valid model, False if invalid model, check fims.log for |
|
| 607 |
* errors. |
|
| 608 |
*/ |
|
| 609 | ! |
bool CreateModel() {
|
| 610 | ! |
bool valid_model = true; |
| 611 | ||
| 612 | ! |
CreateFleetObjects(valid_model); |
| 613 | ||
| 614 | ! |
SetDataObjects(valid_model); |
| 615 | ||
| 616 | ! |
CreatePopulationObjects(valid_model); |
| 617 | ||
| 618 |
//setup priors, random effect, and data density components |
|
| 619 | ! |
SetupPriors(); |
| 620 | ||
| 621 | ! |
return valid_model; |
| 622 |
} |
|
| 623 | ||
| 624 |
/** |
|
| 625 |
* @brief Get the Nages object |
|
| 626 |
* |
|
| 627 |
* @return size_t |
|
| 628 |
*/ |
|
| 629 |
size_t GetNages() const {
|
|
| 630 | ||
| 631 |
return nages; |
|
| 632 |
} |
|
| 633 | ||
| 634 |
/** |
|
| 635 |
* @brief Set the Nages object |
|
| 636 |
* |
|
| 637 |
* @param nages |
|
| 638 |
*/ |
|
| 639 |
void SetNages(size_t nages) {
|
|
| 640 | ||
| 641 |
this->nages = nages; |
|
| 642 |
} |
|
| 643 | ||
| 644 |
/** |
|
| 645 |
* @brief Get the Nseasons object |
|
| 646 |
* |
|
| 647 |
* @return size_t |
|
| 648 |
*/ |
|
| 649 |
size_t GetNseasons() const {
|
|
| 650 | ||
| 651 |
return nseasons; |
|
| 652 |
} |
|
| 653 | ||
| 654 |
/** |
|
| 655 |
* @brief Set the Nseasons object |
|
| 656 |
* |
|
| 657 |
* @param nseasons |
|
| 658 |
*/ |
|
| 659 |
void SetNseasons(size_t nseasons) {
|
|
| 660 | ||
| 661 |
this->nseasons = nseasons; |
|
| 662 |
} |
|
| 663 | ||
| 664 |
/** |
|
| 665 |
* @brief Get the Nyears object |
|
| 666 |
* |
|
| 667 |
* @return size_t |
|
| 668 |
*/ |
|
| 669 |
size_t GetNyears() const {
|
|
| 670 | ||
| 671 |
return nyears; |
|
| 672 |
} |
|
| 673 | ||
| 674 |
/** |
|
| 675 |
* @brief Set the Nyears object |
|
| 676 |
* |
|
| 677 |
* @param nyears |
|
| 678 |
*/ |
|
| 679 |
void SetNyears(size_t nyears) {
|
|
| 680 | ||
| 681 |
this->nyears = nyears; |
|
| 682 |
} |
|
| 683 | ||
| 684 |
/** |
|
| 685 |
* @brief Get the Parameters object |
|
| 686 |
* |
|
| 687 |
* @return std::vector<Type*>& |
|
| 688 |
*/ |
|
| 689 |
std::vector<Type*>& GetParameters() {
|
|
| 690 | ||
| 691 |
return parameters; |
|
| 692 |
} |
|
| 693 | ||
| 694 |
/** |
|
| 695 |
* @brief Get the Fixed Effects Parameters object |
|
| 696 |
* |
|
| 697 |
* @return std::vector<Type*>& |
|
| 698 |
*/ |
|
| 699 |
std::vector<Type*>& GetFixedEffectsParameters() {
|
|
| 700 | ||
| 701 |
return fixed_effects_parameters; |
|
| 702 |
} |
|
| 703 | ||
| 704 |
/** |
|
| 705 |
* @brief Get the Random Effects Parameters object |
|
| 706 |
* |
|
| 707 |
* @return std::vector<Type*>& |
|
| 708 |
*/ |
|
| 709 |
std::vector<Type*>& GetRandomEffectsParameters() {
|
|
| 710 |
return random_effects_parameters; |
|
| 711 |
} |
|
| 712 |
}; |
|
| 713 | ||
| 714 |
template <typename Type> |
|
| 715 |
std::shared_ptr<Information<Type> > Information<Type>::fims_information = |
|
| 716 |
nullptr; // singleton instance |
|
| 717 | ||
| 718 |
} // namespace fims_info |
|
| 719 | ||
| 720 |
#endif /* FIMS_COMMON_INFORMATION_HPP */ |
| 1 |
/** |
|
| 2 |
* @file model.hpp |
|
| 3 |
* @brief TODO: provide a brief description. |
|
| 4 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 5 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 6 |
* folder for reuse information. |
|
| 7 |
*/ |
|
| 8 |
#ifndef FIMS_COMMON_MODEL_HPP |
|
| 9 |
#define FIMS_COMMON_MODEL_HPP |
|
| 10 | ||
| 11 |
#include <future> |
|
| 12 |
#include <memory> |
|
| 13 | ||
| 14 |
#include "information.hpp" |
|
| 15 | ||
| 16 |
namespace fims_model {
|
|
| 17 | ||
| 18 |
/** |
|
| 19 |
* @brief Model class. FIMS objective function. |
|
| 20 |
*/ |
|
| 21 |
template <typename Type> |
|
| 22 |
class Model { // may need singleton
|
|
| 23 |
public: |
|
| 24 |
static std::shared_ptr<Model<Type> > |
|
| 25 |
fims_model; /**< Create a shared fims_model as a pointer to Model*/ |
|
| 26 |
std::shared_ptr<fims_info::Information<Type> > |
|
| 27 |
fims_information; /**< Create a shared fims_information as a pointer to |
|
| 28 |
Information*/ |
|
| 29 | ||
| 30 |
#ifdef TMB_MODEL |
|
| 31 |
::objective_function<Type> *of; |
|
| 32 |
#endif |
|
| 33 | ||
| 34 |
// constructor |
|
| 35 | ||
| 36 | ! |
virtual ~Model() {
|
| 37 |
} |
|
| 38 | ||
| 39 |
/** |
|
| 40 |
* Returns a single Information object for type Type. |
|
| 41 |
* |
|
| 42 |
* @return singleton for type Type |
|
| 43 |
*/ |
|
| 44 | ! |
static std::shared_ptr<Model<Type> > GetInstance() {
|
| 45 | ! |
if (Model<Type>::fims_model == nullptr) {
|
| 46 | ! |
Model<Type>::fims_model = std::make_shared<fims_model::Model<Type> >(); |
| 47 | ! |
Model<Type>::fims_model->fims_information = |
| 48 | ! |
fims_info::Information<Type>::GetInstance(); |
| 49 |
} |
|
| 50 | ! |
return Model<Type>::fims_model; |
| 51 |
} |
|
| 52 | ||
| 53 |
/** |
|
| 54 |
* @brief Evaluate. Calculates the joint negative log-likelihood function. |
|
| 55 |
*/ |
|
| 56 | ! |
const Type Evaluate() {
|
| 57 |
// jnll = negative-log-likelihood (the objective function) |
|
| 58 | ! |
Type jnll = 0.0; |
| 59 | ||
| 60 | ||
| 61 | ! |
int n_fleets = fims_information->fleets.size(); |
| 62 | ! |
int n_pops = fims_information->populations.size(); |
| 63 | ||
| 64 |
// Create vector lists to store output for reporting |
|
| 65 |
#ifdef TMB_MODEL |
|
| 66 |
// vector< vector<Type> > creates a nested vector structure where |
|
| 67 |
// each vector can be a different dimension. Does not work with ADREPORT |
|
| 68 |
// fleets |
|
| 69 | ! |
vector<vector<Type> > exp_index(n_fleets); |
| 70 | ! |
vector<vector<Type> > exp_catch(n_fleets); |
| 71 | ! |
vector<vector<Type> > cnaa(n_fleets); |
| 72 | ! |
vector<vector<Type> > cwaa(n_fleets); |
| 73 | ! |
vector<vector<Type> > cnal(n_fleets); |
| 74 | ! |
vector<vector<Type> > pcnaa(n_fleets); |
| 75 | ! |
vector<vector<Type> > pcnal(n_fleets); |
| 76 | ! |
vector<vector<Type> > F_mort(n_fleets); |
| 77 | ! |
vector<vector<Type> > q(n_fleets); |
| 78 |
// populations |
|
| 79 | ! |
vector<vector<Type> > naa(n_pops); |
| 80 | ! |
vector<vector<Type> > ssb(n_pops); |
| 81 | ! |
vector<vector<Type> > biomass(n_pops); |
| 82 | ! |
vector<vector<Type> > log_recruit_dev(n_pops); |
| 83 | ! |
vector<vector<Type> > recruitment(n_pops); |
| 84 | ! |
vector<vector<Type> > M(n_pops); |
| 85 | ! |
vector<Type> nll_components(this->fims_information->density_components.size()); |
| 86 |
#endif |
|
| 87 |
// Loop over densities and evaluate joint negative log densities for priors |
|
| 88 | ! |
typename fims_info::Information<Type>::density_components_iterator d_it; |
| 89 | ! |
nll_components.fill(0); |
| 90 | ! |
int nll_components_idx = 0; |
| 91 | ! |
size_t n_priors = 0; |
| 92 | ||
| 93 | ! |
for (d_it = this->fims_information->density_components.begin(); |
| 94 | ! |
d_it != this->fims_information->density_components.end(); ++d_it) {
|
| 95 | ! |
std::shared_ptr<fims_distributions::DensityComponentBase<Type> > d = (*d_it).second; |
| 96 |
#ifdef TMB_MODEL |
|
| 97 | ! |
d->of = this->of; |
| 98 |
#endif |
|
| 99 | ! |
if (d->input_type == "prior") {
|
| 100 | ! |
nll_components[nll_components_idx] = -d->evaluate(); |
| 101 | ! |
jnll += nll_components[nll_components_idx]; |
| 102 | ! |
n_priors += 1; |
| 103 | ! |
nll_components_idx += 1; |
| 104 |
} |
|
| 105 |
} |
|
| 106 | ||
| 107 | ||
| 108 | ||
| 109 |
// Loop over populations and evaluate recruitment component |
|
| 110 | ||
| 111 | ! |
typename fims_info::Information<Type>::population_iterator p_it; |
| 112 | ||
| 113 | ||
| 114 | ! |
for (p_it = this->fims_information->populations.begin(); |
| 115 | ! |
p_it != this->fims_information->populations.end(); ++p_it) {
|
| 116 |
//(*p_it).second points to the Population module |
|
| 117 | ! |
std::shared_ptr<fims_popdy::Population<Type> > p = (*p_it).second; |
| 118 | ||
| 119 |
// Prepare recruitment |
|
| 120 | ! |
p->recruitment->Prepare(); |
| 121 | ||
| 122 |
} |
|
| 123 | ||
| 124 |
// Loop over densities and evaluate joint negative log-likelihoods for random effects |
|
| 125 | ! |
this->fims_information->SetupRandomEffects(); |
| 126 | ! |
size_t n_random_effects = 0; |
| 127 | ! |
for (d_it = this->fims_information->density_components.begin(); |
| 128 | ! |
d_it != this->fims_information->density_components.end(); ++d_it) {
|
| 129 | ! |
std::shared_ptr<fims_distributions::DensityComponentBase<Type> > d = (*d_it).second; |
| 130 |
#ifdef TMB_MODEL |
|
| 131 | ! |
d->of = this->of; |
| 132 |
#endif |
|
| 133 | ! |
if (d->input_type == "random_effects") {
|
| 134 | ! |
nll_components[nll_components_idx] = -d->evaluate(); |
| 135 | ! |
jnll += nll_components[nll_components_idx]; |
| 136 | ! |
n_random_effects += 1; |
| 137 | ! |
nll_components_idx += 1; |
| 138 |
} |
|
| 139 |
} |
|
| 140 | ||
| 141 | ||
| 142 |
// Loop over and evaluate populations |
|
| 143 | ! |
for (p_it = this->fims_information->populations.begin(); |
| 144 | ! |
p_it != this->fims_information->populations.end(); ++p_it) {
|
| 145 |
//(*p_it).second points to the Population module |
|
| 146 | ! |
std::shared_ptr<fims_popdy::Population<Type> > p = (*p_it).second; |
| 147 |
// link to TMB objective function |
|
| 148 |
#ifdef TMB_MODEL |
|
| 149 | ! |
p->of = this->of; |
| 150 |
#endif |
|
| 151 |
// Evaluate population |
|
| 152 | ! |
p->Evaluate(); |
| 153 |
} |
|
| 154 | ||
| 155 | ! |
typename fims_info::Information<Type>::fleet_iterator f_it; |
| 156 |
// Loop over fleets/surveys, and evaluate age comp and index expected values |
|
| 157 | ! |
for (f_it = this->fims_information->fleets.begin(); |
| 158 | ! |
f_it != this->fims_information->fleets.end(); ++f_it) {
|
| 159 |
//(*f_it).second points to each individual Fleet module |
|
| 160 | ! |
std::shared_ptr<fims_popdy::Fleet<Type> > f = (*f_it).second; |
| 161 |
#ifdef TMB_MODEL |
|
| 162 | ! |
f->of = this->of; |
| 163 |
#endif |
|
| 164 | ||
| 165 | ! |
f->evaluate_age_comp(); |
| 166 | ! |
if (f->nlengths > 0) {
|
| 167 | ! |
f->evaluate_length_comp(); |
| 168 |
} |
|
| 169 | ! |
f->evaluate_index(); |
| 170 |
} |
|
| 171 | ! |
this->fims_information->SetupData(); |
| 172 |
// Loop over and evaluate data joint negative log-likelihoods |
|
| 173 | ! |
int n_data = 0; |
| 174 | ! |
for (d_it = this->fims_information->density_components.begin(); |
| 175 | ! |
d_it != this->fims_information->density_components.end(); ++d_it) {
|
| 176 | ! |
std::shared_ptr<fims_distributions::DensityComponentBase<Type> > d = (*d_it).second; |
| 177 |
#ifdef TMB_MODEL |
|
| 178 | ! |
d->of = this->of; |
| 179 |
//d->keep = this->keep; |
|
| 180 |
#endif |
|
| 181 | ! |
if (d->input_type == "data") {
|
| 182 | ! |
nll_components[nll_components_idx] = -d->evaluate(); |
| 183 | ! |
jnll += nll_components[nll_components_idx]; |
| 184 | ! |
n_data += 1; |
| 185 | ! |
nll_components_idx += 1; |
| 186 |
} |
|
| 187 |
} |
|
| 188 | ||
| 189 |
// initiate population index for structuring report out objects |
|
| 190 | ! |
int pop_idx = 0; |
| 191 | ! |
for (p_it = this->fims_information->populations.begin(); |
| 192 | ! |
p_it != this->fims_information->populations.end(); ++p_it) {
|
| 193 | ! |
std::shared_ptr<fims_popdy::Population<Type> > p = (*p_it).second; |
| 194 |
#ifdef TMB_MODEL |
|
| 195 | ! |
naa(pop_idx) = vector<Type>(p->numbers_at_age); |
| 196 | ! |
ssb(pop_idx) = vector<Type>(p->spawning_biomass); |
| 197 | ! |
log_recruit_dev(pop_idx) = |
| 198 | ! |
vector<Type>(p->recruitment->log_recruit_devs); |
| 199 | ! |
recruitment(pop_idx) = vector<Type>(p->expected_recruitment); |
| 200 | ! |
biomass(pop_idx) = vector<Type>(p->biomass); |
| 201 | ! |
M(pop_idx) = vector<Type>(p->M); |
| 202 |
#endif |
|
| 203 | ! |
pop_idx += 1; |
| 204 |
} |
|
| 205 | ||
| 206 |
// initiate fleet index for structuring report out objects |
|
| 207 | ! |
int fleet_idx = 0; |
| 208 | ! |
for (f_it = this->fims_information->fleets.begin(); |
| 209 | ! |
f_it != this->fims_information->fleets.end(); ++f_it) {
|
| 210 | ! |
std::shared_ptr<fims_popdy::Fleet<Type> > f = (*f_it).second; |
| 211 |
#ifdef TMB_MODEL |
|
| 212 | ! |
exp_index(fleet_idx) = f->expected_index; |
| 213 | ! |
exp_catch(fleet_idx) = f->expected_catch; |
| 214 | ! |
F_mort(fleet_idx) = f->Fmort; |
| 215 | ! |
q(fleet_idx) = f->q; |
| 216 | ! |
cnaa(fleet_idx) = f->catch_numbers_at_age; |
| 217 | ! |
cnal(fleet_idx) = f->catch_numbers_at_length; |
| 218 | ! |
pcnaa(fleet_idx) = f->proportion_catch_numbers_at_age; |
| 219 | ! |
pcnal(fleet_idx) = f->proportion_catch_numbers_at_length; |
| 220 | ! |
cwaa(fleet_idx) = f->catch_weight_at_age; |
| 221 |
#endif |
|
| 222 | ! |
fleet_idx += 1; |
| 223 |
} |
|
| 224 | ||
| 225 |
// Reporting |
|
| 226 |
#ifdef TMB_MODEL |
|
| 227 |
//FIMS_REPORT_F(rec_nll, of); |
|
| 228 |
//FIMS_REPORT_F(age_comp_nll, of); |
|
| 229 |
//FIMS_REPORT_F(index_nll, of); |
|
| 230 | ! |
FIMS_REPORT_F(jnll, of); |
| 231 | ! |
FIMS_REPORT_F(naa, of); |
| 232 | ! |
FIMS_REPORT_F(ssb, of); |
| 233 | ! |
FIMS_REPORT_F(log_recruit_dev, of); |
| 234 | ! |
FIMS_REPORT_F(recruitment, of); |
| 235 | ! |
FIMS_REPORT_F(biomass, of); |
| 236 | ! |
FIMS_REPORT_F(M, of); |
| 237 | ! |
FIMS_REPORT_F(exp_index, of); |
| 238 | ! |
FIMS_REPORT_F(exp_catch, of); |
| 239 | ! |
FIMS_REPORT_F(F_mort, of); |
| 240 | ! |
FIMS_REPORT_F(q, of); |
| 241 | ! |
FIMS_REPORT_F(cnaa, of); |
| 242 | ! |
FIMS_REPORT_F(cnal, of); |
| 243 | ! |
FIMS_REPORT_F(pcnaa, of); |
| 244 | ! |
FIMS_REPORT_F(pcnal, of); |
| 245 | ! |
FIMS_REPORT_F(cwaa, of); |
| 246 | ! |
FIMS_REPORT_F(nll_components, of); |
| 247 | ||
| 248 |
/*ADREPORT using ADREPORTvector defined in |
|
| 249 |
* inst/include/interface/interface.hpp: |
|
| 250 |
* function collapses the nested vector into a single vector |
|
| 251 |
*/ |
|
| 252 | ! |
vector<Type> NAA = ADREPORTvector(naa); |
| 253 | ! |
vector<Type> Biomass = ADREPORTvector(biomass); |
| 254 | ! |
vector<Type> SSB = ADREPORTvector(ssb); |
| 255 | ! |
vector<Type> LogRecDev = ADREPORTvector(log_recruit_dev); |
| 256 | ! |
vector<Type> FMort = ADREPORTvector(F_mort); |
| 257 | ! |
vector<Type> Q = ADREPORTvector(q); |
| 258 | ! |
vector<Type> ExpectedIndex = ADREPORTvector(exp_index); |
| 259 | ! |
vector<Type> CNAA = ADREPORTvector(cnaa); |
| 260 | ! |
vector<Type> CNAL = ADREPORTvector(cnal); |
| 261 | ! |
vector<Type> PCNAA = ADREPORTvector(pcnaa); |
| 262 | ! |
vector<Type> PCNAL = ADREPORTvector(pcnal); |
| 263 | ||
| 264 | ! |
ADREPORT_F(NAA, of); |
| 265 | ! |
ADREPORT_F(Biomass, of); |
| 266 | ! |
ADREPORT_F(SSB, of); |
| 267 | ! |
ADREPORT_F(LogRecDev, of); |
| 268 | ! |
ADREPORT_F(FMort, of); |
| 269 | ! |
ADREPORT_F(Q, of); |
| 270 | ! |
ADREPORT_F(ExpectedIndex, of); |
| 271 | ! |
ADREPORT_F(CNAA, of); |
| 272 | ! |
ADREPORT_F(CNAL, of); |
| 273 | ! |
ADREPORT_F(PCNAA, of); |
| 274 | ! |
ADREPORT_F(PCNAL, of); |
| 275 |
#endif |
|
| 276 | ||
| 277 | ! |
return jnll; |
| 278 |
} |
|
| 279 |
}; |
|
| 280 | ||
| 281 |
// Create singleton instance of Model class |
|
| 282 |
template <typename Type> |
|
| 283 |
std::shared_ptr<Model<Type> > Model<Type>::fims_model = |
|
| 284 |
nullptr; // singleton instance |
|
| 285 |
} // namespace fims_model |
|
| 286 | ||
| 287 |
#endif /* FIMS_COMMON_MODEL_HPP */ |
| 1 | ||
| 2 |
/** |
|
| 3 |
* @file density_components_base.hpp |
|
| 4 |
* @brief Declares the DensityComponentBase class, which is the base class for |
|
| 5 |
* all distribution functors. |
|
| 6 |
* @details Defines guards for distributions module outline to define the |
|
| 7 |
* density_components_base hpp file if not already defined. |
|
| 8 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 9 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 10 |
* folder for reuse information. |
|
| 11 |
*/ |
|
| 12 |
#ifndef DENSITY_COMPONENT_BASE_HPP |
|
| 13 |
#define DENSITY_COMPONENT_BASE_HPP |
|
| 14 | ||
| 15 |
#include "../../common/data_object.hpp" |
|
| 16 |
#include "../../common/model_object.hpp" |
|
| 17 |
#include "../../interface/interface.hpp" |
|
| 18 |
#include "../../common/fims_vector.hpp" |
|
| 19 |
#include "../../common/fims_math.hpp" |
|
| 20 | ||
| 21 |
namespace fims_distributions {
|
|
| 22 | ||
| 23 |
/** @brief Base class for all module_name functors. |
|
| 24 |
* |
|
| 25 |
* @tparam Type The type of the module_name functor. |
|
| 26 |
* |
|
| 27 |
*/ |
|
| 28 |
template <typename Type> |
|
| 29 |
struct DensityComponentBase : public fims_model_object::FIMSObject<Type> {
|
|
| 30 |
// id_g is the ID of the instance of the DensityComponentBase class. |
|
| 31 |
// this is like a memory tracker. |
|
| 32 |
// Assigning each one its own ID is a way to keep track of |
|
| 33 |
// all the instances of the DensityComponentBase class. |
|
| 34 |
static uint32_t id_g; /**< global unique identifier for distribution modules */ |
|
| 35 | ! |
int observed_data_id_m = -999; /*!< id of observed data component*/ |
| 36 |
std::shared_ptr<fims_data_object::DataObject<Type>> |
|
| 37 |
observed_values; /**< observed data*/ |
|
| 38 |
fims::Vector<Type > x; /**< input value of distribution function for priors or random effects*/ |
|
| 39 |
fims::Vector<Type> expected_values; /**< expected value of distribution function */ |
|
| 40 |
fims::Vector<Type> lpdf_vec; /**< vector to record observation level negative log-likelihood values */ |
|
| 41 |
std::string input_type; /**< string classifies the type of the negative log-likelihood; options are: "priors", "random_effects", and "data" */ |
|
| 42 | ! |
bool osa_flag = false; /**< Boolean; if true, osa residuals are calculated */ |
| 43 | ! |
bool simulate_flag = false; /**< Boolean; if true, data are simulated from the distribution */ |
| 44 |
std::vector<uint32_t> key; /**< unique id for variable map that points to a fims::Vector */ |
|
| 45 | ||
| 46 |
#ifdef TMB_MODEL |
|
| 47 |
::objective_function<Type> *of; /**< Pointer to the TMB objective function */ |
|
| 48 |
#endif |
|
| 49 | ||
| 50 |
/** @brief Constructor. |
|
| 51 |
*/ |
|
| 52 | ! |
DensityComponentBase() { this->id = DensityComponentBase::id_g++; }
|
| 53 | ||
| 54 | ! |
virtual ~DensityComponentBase() {}
|
| 55 |
/** |
|
| 56 |
* @brief Generic probability density function. Calculates the pdf at the |
|
| 57 |
* independent variable value. |
|
| 58 |
*/ |
|
| 59 |
virtual const Type evaluate() = 0; |
|
| 60 |
}; |
|
| 61 | ||
| 62 |
/** @brief Default id of the singleton distribution class |
|
| 63 |
*/ |
|
| 64 |
template <typename Type> |
|
| 65 |
uint32_t DensityComponentBase<Type>::id_g = 0; |
|
| 66 | ||
| 67 |
} // namespace fims_distributions |
|
| 68 | ||
| 69 |
#endif /* DENSITY_COMPONENT_BASE_HPP */ |
| 1 |
/** |
|
| 2 |
* @file lognormal_lpdf.hpp |
|
| 3 |
* @brief Lognormal Log Probability Density Function (LPDF) defines the |
|
| 4 |
* Lognormal LPDF class and its fields and returns the log probability density |
|
| 5 |
* function. |
|
| 6 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 7 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 8 |
* folder for reuse information. |
|
| 9 |
*/ |
|
| 10 |
#ifndef LOGNORMAL_LPDF |
|
| 11 |
#define LOGNORMAL_LPDF |
|
| 12 | ||
| 13 |
#include "density_components_base.hpp" |
|
| 14 |
#include "../../common/fims_vector.hpp" |
|
| 15 |
#include "../../common/def.hpp" |
|
| 16 | ||
| 17 |
namespace fims_distributions |
|
| 18 |
{
|
|
| 19 |
/** |
|
| 20 |
* LogNormal Log Probability Density Function |
|
| 21 |
*/ |
|
| 22 |
template <typename Type> |
|
| 23 |
struct LogNormalLPDF : public DensityComponentBase<Type> |
|
| 24 |
{
|
|
| 25 |
fims::Vector<Type> log_sd; /**< natural log of the standard deviation of the distribution on the log scale; can be a vector or scalar */ |
|
| 26 | ! |
Type lpdf = 0.0; /**< total log probability density contribution of the distribution */ |
| 27 |
// data_indicator<tmbutils::vector<Type> , Type> keep; /**< Indicator used in TMB one-step-ahead residual calculations */ |
|
| 28 | ||
| 29 |
/** @brief Constructor. |
|
| 30 |
*/ |
|
| 31 | ! |
LogNormalLPDF() : DensityComponentBase<Type>() |
| 32 |
{
|
|
| 33 |
} |
|
| 34 | ||
| 35 |
/** @brief Destructor. |
|
| 36 |
*/ |
|
| 37 | ! |
virtual ~LogNormalLPDF() {}
|
| 38 | ||
| 39 |
/** |
|
| 40 |
* @brief Evaluates the lognormal probability density function |
|
| 41 |
*/ |
|
| 42 | ! |
virtual const Type evaluate() |
| 43 |
{
|
|
| 44 |
// set vector size based on input type (prior, process, or data) |
|
| 45 |
size_t n_x; |
|
| 46 | ! |
if(this->input_type == "data"){
|
| 47 | ! |
n_x = this->observed_values->data.size(); |
| 48 |
} else {
|
|
| 49 | ! |
n_x = this->x.size(); |
| 50 |
} |
|
| 51 |
// setup vector for recording the log probability density function values |
|
| 52 | ! |
this->lpdf_vec.resize(n_x); |
| 53 | ! |
std::fill(this->lpdf_vec.begin(), this->lpdf_vec.end(), 0); |
| 54 | ! |
lpdf = 0; |
| 55 | ||
| 56 | ! |
for (size_t i = 0; i < n_x; i++) |
| 57 |
{
|
|
| 58 |
#ifdef TMB_MODEL |
|
| 59 | ! |
if(this->input_type == "data"){
|
| 60 |
// if data, check if there are any NA values and skip lpdf calculation if there are |
|
| 61 |
// See Deroba and Miller, 2016 (https://doi.org/10.1016/j.fishres.2015.12.002) for |
|
| 62 |
// the use of lognormal constant |
|
| 63 | ! |
if(this->observed_values->at(i) != this->observed_values->na_value){
|
| 64 | ! |
this->lpdf_vec[i] = dnorm(log(this->observed_values->at(i)), this->expected_values.get_force_scalar(i), |
| 65 | ! |
fims_math::exp(log_sd.get_force_scalar(i)), true) - log(this->observed_values->at(i)); |
| 66 |
} else {
|
|
| 67 | ! |
this->lpdf_vec[i] = 0; |
| 68 |
} |
|
| 69 |
// if not data (i.e. prior or process), use x vector instead of observed_values and no lognormal constant needs to be applied |
|
| 70 |
} else {
|
|
| 71 | ! |
this->lpdf_vec[i] = dnorm(log(this->x[i]), this->expected_values.get_force_scalar(i), |
| 72 | ! |
fims_math::exp(log_sd.get_force_scalar(i)), true); |
| 73 |
} |
|
| 74 | ||
| 75 | ! |
lpdf += this->lpdf_vec[i]; |
| 76 | ! |
if (this->simulate_flag) |
| 77 |
{
|
|
| 78 | ! |
FIMS_SIMULATE_F(this->of) |
| 79 |
{ // preprocessor definition in interface.hpp
|
|
| 80 |
// this simulates data that is mean biased |
|
| 81 | ! |
if(this->input_type == "data"){
|
| 82 | ! |
this->observed_values->at(i) = fims_math::exp(rnorm(this->expected_values.get_force_scalar(i), |
| 83 | ! |
fims_math::exp(log_sd.get_force_scalar(i)))); |
| 84 |
} else {
|
|
| 85 | ! |
this->x[i] = fims_math::exp(rnorm(this->expected_values.get_force_scalar(i), |
| 86 | ! |
fims_math::exp(log_sd.get_force_scalar(i)))); |
| 87 |
} |
|
| 88 |
} |
|
| 89 |
} |
|
| 90 |
#endif |
|
| 91 |
} |
|
| 92 |
#ifdef TMB_MODEL |
|
| 93 | ! |
vector<Type> lognormal_x = this->x; |
| 94 |
// FIMS_REPORT_F(lognormal_x, this->of); |
|
| 95 |
#endif |
|
| 96 | ! |
return (lpdf); |
| 97 |
} |
|
| 98 |
}; |
|
| 99 |
} // namespace fims_distributions |
|
| 100 |
#endif |
| 1 |
/** |
|
| 2 |
* @file multinomial_lpmf.hpp |
|
| 3 |
* @brief Multinomial Log Probability Mass Function (LPMF) module file defines |
|
| 4 |
* the Multinomial LPMF class and its fields and returns the log probability |
|
| 5 |
* mass function. |
|
| 6 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 7 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 8 |
* folder for reuse information. |
|
| 9 |
*/ |
|
| 10 |
#ifndef MULTINOMIAL_LPMF |
|
| 11 |
#define MULTINOMIAL_LPMF |
|
| 12 | ||
| 13 |
#include "density_components_base.hpp" |
|
| 14 |
#include "../../common/fims_vector.hpp" |
|
| 15 |
#include "../../common/def.hpp" |
|
| 16 | ||
| 17 |
namespace fims_distributions |
|
| 18 |
{
|
|
| 19 |
/** |
|
| 20 |
* Multinomial Log Probability Mass Function |
|
| 21 |
*/ |
|
| 22 |
template <typename Type> |
|
| 23 |
struct MultinomialLPMF : public DensityComponentBase<Type> |
|
| 24 |
{
|
|
| 25 | ! |
Type lpdf = 0.0; /**< total negative log-likelihood contribution of the distribution */ |
| 26 |
fims::Vector<size_t> dims; /**< Dimensions of the number of rows and columns of the multivariate dataset */ |
|
| 27 | ||
| 28 |
/** @brief Constructor. |
|
| 29 |
*/ |
|
| 30 | ! |
MultinomialLPMF() : DensityComponentBase<Type>() |
| 31 |
{
|
|
| 32 |
} |
|
| 33 | ||
| 34 |
/** @brief Destructor. |
|
| 35 |
*/ |
|
| 36 | ! |
virtual ~MultinomialLPMF() {}
|
| 37 | ||
| 38 |
/** |
|
| 39 |
* @brief Evaluates the multinomial probability mass function |
|
| 40 |
*/ |
|
| 41 | ! |
virtual const Type evaluate() |
| 42 |
{
|
|
| 43 |
// set dims using observed_values if no user input |
|
| 44 | ! |
if(dims.size() != 2){
|
| 45 | ! |
dims.resize(2); |
| 46 | ! |
dims[0] = this->observed_values->get_imax(); |
| 47 | ! |
dims[1] = this->observed_values->get_jmax(); |
| 48 |
} |
|
| 49 | ||
| 50 | ||
| 51 |
// setup vector for recording the log probability density function values |
|
| 52 | ! |
Type lpdf = 0.0; /**< total log probability mass contribution of the distribution */ |
| 53 | ! |
this->lpdf_vec.resize(dims[0]); |
| 54 | ! |
std::fill(this->lpdf_vec.begin(), this->lpdf_vec.end(), 0); |
| 55 | ||
| 56 | ! |
if (dims[0]*dims[1] != this->expected_values.size()) {
|
| 57 | ! |
FIMS_ERROR_LOG("Observed age comp is of size " + fims::to_string(dims[0]*dims[1])
|
| 58 |
+ " and expected is of size " + fims::to_string(this->expected_values.size())); |
|
| 59 |
} else {
|
|
| 60 | ! |
for (size_t i = 0; i < dims[0]; i++) |
| 61 |
{
|
|
| 62 |
// for each row, create new x and prob vectors |
|
| 63 | ! |
fims::Vector<Type> x_vector; |
| 64 | ! |
fims::Vector<Type> prob_vector; |
| 65 | ! |
x_vector.resize(dims[1]); |
| 66 | ! |
prob_vector.resize(dims[1]); |
| 67 | ||
| 68 | ! |
bool containsNA = |
| 69 |
false; /**< skips the entire row if any values are NA */ |
|
| 70 | ||
| 71 |
#ifdef TMB_MODEL |
|
| 72 | ! |
for (size_t j = 0; j < dims[1]; j++){
|
| 73 | ! |
if(this->input_type == "data"){
|
| 74 |
// if data, check if there are any NA values and skip lpdf calculation for entire row if there are |
|
| 75 | ! |
if (this->observed_values->at(i, j) == |
| 76 | ! |
this->observed_values->na_value) {
|
| 77 | ! |
containsNA = true; |
| 78 | ! |
break; |
| 79 |
} |
|
| 80 | ! |
if(!containsNA){
|
| 81 | ! |
size_t idx = (i * dims[1]) + j; |
| 82 | ! |
x_vector[j] = this->observed_values->at(i, j); |
| 83 | ! |
prob_vector[j] = this->expected_values[idx]; |
| 84 |
} |
|
| 85 |
} else {
|
|
| 86 |
// if not data (i.e. prior or process), use x vector instead of observed_values |
|
| 87 | ! |
size_t idx = (i * dims[1]) + j; |
| 88 | ! |
x_vector[j] = this->x[idx]; |
| 89 | ! |
prob_vector[j] = this->expected_values[idx]; |
| 90 |
} |
|
| 91 |
} |
|
| 92 | ||
| 93 | ! |
if(!containsNA){
|
| 94 | ! |
this->lpdf_vec[i] = dmultinom((vector<Type>)x_vector, (vector<Type>) prob_vector, true); |
| 95 |
} else {
|
|
| 96 | ! |
this->lpdf_vec[i] = 0; |
| 97 |
} |
|
| 98 | ! |
lpdf += this->lpdf_vec[i]; |
| 99 |
/* |
|
| 100 |
if (this->simulate_flag) |
|
| 101 |
{
|
|
| 102 |
FIMS_SIMULATE_F(this->of) |
|
| 103 |
{
|
|
| 104 |
fims::Vector<Type> sim_observed; |
|
| 105 |
sim_observed.resize(dims[1]); |
|
| 106 |
sim_observed = rmultinom(prob_vector); |
|
| 107 |
sim_observed.resize(this->x); |
|
| 108 |
for (size_t j = 0; j < dims[1]; j++) |
|
| 109 |
{
|
|
| 110 |
idx = (i * dims[1]) + j; |
|
| 111 |
this->x[idx] = sim_observed[j]; |
|
| 112 |
} |
|
| 113 |
} |
|
| 114 |
} |
|
| 115 |
*/ |
|
| 116 |
#endif |
|
| 117 |
} |
|
| 118 |
} |
|
| 119 |
#ifdef TMB_MODEL |
|
| 120 |
#endif |
|
| 121 | ! |
return (lpdf); |
| 122 |
} |
|
| 123 | ||
| 124 |
}; |
|
| 125 |
} // namespace fims_distributions |
|
| 126 |
#endif |
| 1 |
/** |
|
| 2 |
* @file normal_lpdf.hpp |
|
| 3 |
* @brief Normal Log Probability Density Function (LPDF) module file defines |
|
| 4 |
* the Normal LPDF class and its fields and returns the log probability density |
|
| 5 |
* function. |
|
| 6 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 7 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 8 |
* folder for reuse information. |
|
| 9 |
*/ |
|
| 10 | ||
| 11 |
#ifndef NORMAL_LPDF |
|
| 12 |
#define NORMAL_LPDF |
|
| 13 | ||
| 14 |
#include "density_components_base.hpp" |
|
| 15 |
#include "../../common/fims_vector.hpp" |
|
| 16 |
#include "../../common/def.hpp" |
|
| 17 | ||
| 18 |
namespace fims_distributions {
|
|
| 19 |
/** |
|
| 20 |
* Normal Log Probability Density Function |
|
| 21 |
*/ |
|
| 22 |
template<typename Type> |
|
| 23 |
struct NormalLPDF : public DensityComponentBase<Type> {
|
|
| 24 |
fims::Vector<Type> log_sd; /**< the natural log of the standard deviation of the distribution; can be a vector or scalar */ |
|
| 25 | ! |
Type lpdf = 0.0; /**< total log probability density contribution of the distribution */ |
| 26 | ||
| 27 |
/** @brief Constructor. |
|
| 28 |
*/ |
|
| 29 | ! |
NormalLPDF() : DensityComponentBase<Type>() {
|
| 30 | ||
| 31 |
} |
|
| 32 | ||
| 33 |
/** @brief Destructor. |
|
| 34 |
*/ |
|
| 35 | ! |
virtual ~NormalLPDF() {}
|
| 36 | ||
| 37 |
/** |
|
| 38 |
* @brief Evaluates the normal probability density function |
|
| 39 |
*/ |
|
| 40 | ! |
virtual const Type evaluate(){
|
| 41 |
// set vector size based on input type (prior, process, or data) |
|
| 42 |
size_t n_x; |
|
| 43 | ! |
if(this->input_type == "data"){
|
| 44 | ! |
n_x = this->observed_values->data.size(); |
| 45 |
} else {
|
|
| 46 | ! |
n_x = this->x.size(); |
| 47 |
} |
|
| 48 |
// setup vector for recording the log probability density function values |
|
| 49 | ! |
this->lpdf_vec.resize(n_x); |
| 50 | ! |
std::fill(this->lpdf_vec.begin(), this->lpdf_vec.end(), 0); |
| 51 | ! |
lpdf = 0; |
| 52 | ||
| 53 | ! |
for(size_t i=0; i<n_x; i++){
|
| 54 |
#ifdef TMB_MODEL |
|
| 55 | ! |
if(this->input_type == "data"){
|
| 56 |
// if data, check if there are any NA values and skip lpdf calculation if there are |
|
| 57 | ! |
if(this->observed_values->at(i) != this->observed_values->na_value){
|
| 58 | ! |
this->lpdf_vec[i] = dnorm(this->observed_values->at(i), this->expected_values.get_force_scalar(i), fims_math::exp(log_sd.get_force_scalar(i)), true); |
| 59 |
} else {
|
|
| 60 | ! |
this->lpdf_vec[i] = 0; |
| 61 |
} |
|
| 62 |
// if not data (i.e. prior or process), use x vector instead of observed_values |
|
| 63 |
} else {
|
|
| 64 | ! |
this->lpdf_vec[i] = dnorm(this->x[i], this->expected_values.get_force_scalar(i), fims_math::exp(log_sd.get_force_scalar(i)), true); |
| 65 |
} |
|
| 66 | ! |
lpdf += this->lpdf_vec[i]; |
| 67 | ! |
if(this->simulate_flag){
|
| 68 | ! |
FIMS_SIMULATE_F(this->of){
|
| 69 | ! |
if(this->input_type == "data"){
|
| 70 | ! |
this->observed_values->at(i) = rnorm(this->expected_values.get_force_scalar(i), fims_math::exp(log_sd.get_force_scalar(i))); |
| 71 |
} else {
|
|
| 72 | ! |
this->x[i] = rnorm(this->expected_values.get_force_scalar(i), fims_math::exp(log_sd.get_force_scalar(i))); |
| 73 |
} |
|
| 74 |
} |
|
| 75 |
} |
|
| 76 |
#endif |
|
| 77 |
/* osa not working yet |
|
| 78 |
if(osa_flag){//data observation type implements osa residuals
|
|
| 79 |
//code for osa cdf method |
|
| 80 |
this->lpdf_vec[i] = this->keep.cdf_lower[i] * log( pnorm(this->x[i], this->expected_values.get_force_scalar(i), sd[i]) ); |
|
| 81 |
this->lpdf_vec[i] = this->keep.cdf_upper[i] * log( 1.0 - pnorm(this->x[i], this->expected_values.get_force_scalar(i), sd[i]) ); |
|
| 82 |
} */ |
|
| 83 | ||
| 84 |
} |
|
| 85 |
#ifdef TMB_MODEL |
|
| 86 | ! |
vector<Type> normal_x = this->x; |
| 87 |
#endif |
|
| 88 | ! |
return(lpdf); |
| 89 |
} |
|
| 90 | ||
| 91 |
}; |
|
| 92 | ||
| 93 |
} // namespace fims_distributions |
|
| 94 |
#endif |
| 1 |
/** |
|
| 2 |
* @file init.hpp |
|
| 3 |
* @brief An interface to dynamically load the functions. |
|
| 4 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 5 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 6 |
* folder for reuse information. |
|
| 7 |
*/ |
|
| 8 |
#ifndef INTERFACE_INIT_HPP |
|
| 9 |
#define INTERFACE_INIT_HPP |
|
| 10 |
#include <R_ext/Rdynload.h> |
|
| 11 |
#include <stdlib.h> |
|
| 12 | ||
| 13 |
/** |
|
| 14 |
* @brief Callback definition for TMB C++ functions. |
|
| 15 |
*/ |
|
| 16 |
#ifndef TMB_CALLDEFS |
|
| 17 |
#define TMB_CALLDEFS \ |
|
| 18 |
{"MakeADFunObject", (DL_FUNC)&MakeADFunObject, 4}, \
|
|
| 19 |
{"InfoADFunObject", (DL_FUNC)&InfoADFunObject, 1}, \
|
|
| 20 |
{"EvalADFunObject", (DL_FUNC)&EvalADFunObject, 3}, \
|
|
| 21 |
{"MakeDoubleFunObject", (DL_FUNC)&MakeDoubleFunObject, 3}, \
|
|
| 22 |
{"EvalDoubleFunObject", (DL_FUNC)&EvalDoubleFunObject, 3}, \
|
|
| 23 |
{"getParameterOrder", (DL_FUNC)&getParameterOrder, 3}, \
|
|
| 24 |
{"MakeADGradObject", (DL_FUNC)&MakeADGradObject, 3}, \
|
|
| 25 |
{"MakeADHessObject2", (DL_FUNC)&MakeADHessObject2, 4}, \
|
|
| 26 |
{"usingAtomics", (DL_FUNC)&usingAtomics, 0}, { \
|
|
| 27 |
"TMBconfig", (DL_FUNC)&TMBconfig, 2 \ |
|
| 28 |
} |
|
| 29 |
#endif |
|
| 30 | ||
| 31 |
/** |
|
| 32 |
* @brief TODO: provide a brief description. |
|
| 33 |
* |
|
| 34 |
*/ |
|
| 35 |
#define CALLDEF(name, n) \ |
|
| 36 |
{ #name, (DL_FUNC)&name, n }
|
|
| 37 | ||
| 38 |
extern "C" {
|
|
| 39 | ||
| 40 |
/** |
|
| 41 |
* @brief TODO: provide a brief description. |
|
| 42 |
* |
|
| 43 |
* @param mean |
|
| 44 |
* @param nu |
|
| 45 |
* @return SEXP |
|
| 46 |
*/ |
|
| 47 |
SEXP compois_calc_var(SEXP mean, SEXP nu); |
|
| 48 |
/** |
|
| 49 |
* @brief TODO: provide a brief description. |
|
| 50 |
* |
|
| 51 |
* @return SEXP |
|
| 52 |
*/ |
|
| 53 |
SEXP omp_check(); |
|
| 54 |
/** |
|
| 55 |
* @brief TODO: provide a brief description. |
|
| 56 |
* |
|
| 57 |
* @return SEXP |
|
| 58 |
*/ |
|
| 59 |
SEXP omp_num_threads(SEXP); |
|
| 60 |
/** |
|
| 61 |
* @brief TODO: provide a brief description. |
|
| 62 |
* |
|
| 63 |
* @return SEXP |
|
| 64 |
*/ |
|
| 65 |
SEXP _rcpp_module_boot_fims(); |
|
| 66 | ||
| 67 |
/** |
|
| 68 |
* @brief Callback definition to load the FIMS module. |
|
| 69 |
*/ |
|
| 70 |
static const R_CallMethodDef CallEntries[] = {
|
|
| 71 |
TMB_CALLDEFS, |
|
| 72 |
{"_rcpp_module_boot_fims", (DL_FUNC)&_rcpp_module_boot_fims, 0},
|
|
| 73 |
{NULL, NULL, 0}};
|
|
| 74 | ||
| 75 |
/** |
|
| 76 |
* @brief FIMS shared object initializer. |
|
| 77 |
* @param dll TODO: provide a brief description. |
|
| 78 |
* |
|
| 79 |
*/ |
|
| 80 | 2x |
void R_init_FIMS(DllInfo *dll) {
|
| 81 | 2x |
R_registerRoutines(dll, NULL, CallEntries, NULL, NULL); |
| 82 | 2x |
R_useDynamicSymbols(dll, FALSE); |
| 83 |
#ifdef TMB_CCALLABLES |
|
| 84 | 2x |
TMB_CCALLABLES("FIMS");
|
| 85 |
#endif |
|
| 86 |
} |
|
| 87 |
} |
|
| 88 | ||
| 89 |
#endif |
| 1 |
/** |
|
| 2 |
* @file interface.hpp |
|
| 3 |
* @brief An interface to the modeling platforms, e.g., TMB. |
|
| 4 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 5 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 6 |
* folder for reuse information. |
|
| 7 |
*/ |
|
| 8 | ||
| 9 |
#ifndef FIMS_INTERFACE_HPP |
|
| 10 |
#define FIMS_INTERFACE_HPP |
|
| 11 | ||
| 12 |
/* |
|
| 13 |
* @brief Interface file. Uses pre-processing macros |
|
| 14 |
* to interface with multiple modeling platforms. |
|
| 15 |
*/ |
|
| 16 | ||
| 17 |
// traits for interfacing with TMB |
|
| 18 | ||
| 19 |
#ifdef TMB_MODEL |
|
| 20 |
// use isnan macro in math.h instead of TMB's isnan for fixing the r-cmd-check |
|
| 21 |
// issue |
|
| 22 |
#include <math.h> |
|
| 23 | ||
| 24 |
#include <TMB.hpp> |
|
| 25 | ||
| 26 |
// define REPORT, ADREPORT, and SIMULATE |
|
| 27 |
#define FIMS_REPORT_F(name, F) \ |
|
| 28 |
if (isDouble<Type>::value && F->current_parallel_region < 0) { \
|
|
| 29 |
Rf_defineVar(Rf_install(#name), PROTECT(asSEXP(name)), F->report); \ |
|
| 30 |
UNPROTECT(1); \ |
|
| 31 |
} |
|
| 32 |
#define ADREPORT_F(name, F) F->reportvector.push(name, #name); |
|
| 33 | ||
| 34 |
template <typename Type> |
|
| 35 | ! |
vector<Type> ADREPORTvector(vector<vector<Type> > x) {
|
| 36 | ! |
int outer_dim = x.size(); |
| 37 | ! |
int dim = 0; |
| 38 | ! |
for (int i = 0; i < outer_dim; i++) {
|
| 39 | ! |
dim += x(i).size(); |
| 40 |
} |
|
| 41 | ! |
vector<Type> res(dim); |
| 42 | ! |
int idx = 0; |
| 43 | ! |
for (int i = 0; i < outer_dim; i++) {
|
| 44 | ! |
int inner_dim = x(i).size(); |
| 45 | ! |
for (int j = 0; j < inner_dim; j++) {
|
| 46 | ! |
res(idx) = x(i)(j); |
| 47 | ! |
idx += 1; |
| 48 |
} |
|
| 49 |
} |
|
| 50 | ! |
return res; |
| 51 |
} |
|
| 52 | ||
| 53 | ||
| 54 | ||
| 55 |
#define FIMS_SIMULATE_F(F) if (isDouble<Type>::value && F->do_simulate) |
|
| 56 | ||
| 57 |
#endif /* TMB_MODEL */ |
|
| 58 | ||
| 59 |
#ifndef TMB_MODEL |
|
| 60 |
/** |
|
| 61 |
* @brief TODO: provide a brief description. |
|
| 62 |
*/ |
|
| 63 |
#define FIMS_SIMULATE_F(F) |
|
| 64 |
/** |
|
| 65 |
* @brief TODO: provide a brief description. |
|
| 66 |
*/ |
|
| 67 |
#define FIMS_REPORT_F(name, F) |
|
| 68 |
/** |
|
| 69 |
* @brief TODO: provide a brief description. |
|
| 70 |
*/ |
|
| 71 |
#define ADREPORT_F(name, F) |
|
| 72 |
#endif |
|
| 73 | ||
| 74 |
#endif /* FIMS_INTERFACE_HPP */ |
| 1 |
/** |
|
| 2 |
* @file rcpp_interface.hpp |
|
| 3 |
* @brief The Rcpp interface to declare things. Allows for the use of |
|
| 4 |
* methods::new() in R. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef FIMS_INTERFACE_RCPP_INTERFACE_HPP |
|
| 10 |
#define FIMS_INTERFACE_RCPP_INTERFACE_HPP |
|
| 11 | ||
| 12 |
#include "rcpp_objects/rcpp_data.hpp" |
|
| 13 |
#include "rcpp_objects/rcpp_fleet.hpp" |
|
| 14 |
#include "rcpp_objects/rcpp_growth.hpp" |
|
| 15 |
#include "rcpp_objects/rcpp_maturity.hpp" |
|
| 16 |
#include "rcpp_objects/rcpp_natural_mortality.hpp" |
|
| 17 |
#include "../../common/model.hpp" |
|
| 18 |
#include "rcpp_objects/rcpp_population.hpp" |
|
| 19 |
#include "rcpp_objects/rcpp_recruitment.hpp" |
|
| 20 |
#include "rcpp_objects/rcpp_selectivity.hpp" |
|
| 21 |
#include "rcpp_objects/rcpp_distribution.hpp" |
|
| 22 |
#include "../../utilities/fims_json.hpp" |
|
| 23 | ||
| 24 |
/** |
|
| 25 |
* @brief TODO: provide a brief description. |
|
| 26 |
* |
|
| 27 |
*/ |
|
| 28 |
SEXP FIMS_objective_function; |
|
| 29 |
/** |
|
| 30 |
* @brief TODO: provide a brief description. |
|
| 31 |
* |
|
| 32 |
*/ |
|
| 33 |
SEXP FIMS_gradient_function; |
|
| 34 |
/** |
|
| 35 |
* @brief A double to store the objective function value. |
|
| 36 |
* |
|
| 37 |
*/ |
|
| 38 |
double FIMS_function_value = 0; |
|
| 39 |
/** |
|
| 40 |
* @brief TODO: provide a brief description. |
|
| 41 |
* |
|
| 42 |
*/ |
|
| 43 |
Rcpp::NumericVector FIMS_function_parameters; |
|
| 44 |
/** |
|
| 45 |
* @brief TODO: provide a brief description. |
|
| 46 |
* |
|
| 47 |
*/ |
|
| 48 |
Rcpp::NumericVector FIMS_function_gradient; |
|
| 49 |
/** |
|
| 50 |
* @brief A double to store the maximum gradient component. |
|
| 51 |
* |
|
| 52 |
*/ |
|
| 53 |
double FIMS_mgc_value = 0; |
|
| 54 |
/** |
|
| 55 |
* @brief Sets FIMS_finalized to false as the default. |
|
| 56 |
* |
|
| 57 |
*/ |
|
| 58 |
bool FIMS_finalized = false; |
|
| 59 | ||
| 60 |
/** |
|
| 61 |
* Initializes the logging system, setting all signal handling. |
|
| 62 |
*/ |
|
| 63 | ! |
void init_logging() {
|
| 64 | ! |
std::signal(SIGSEGV, &fims::WriteAtExit); |
| 65 | ! |
std::signal(SIGINT, &fims::WriteAtExit); |
| 66 | ! |
std::signal(SIGABRT, &fims::WriteAtExit); |
| 67 | ! |
std::signal(SIGFPE, &fims::WriteAtExit); |
| 68 | ! |
std::signal(SIGILL, &fims::WriteAtExit); |
| 69 | ! |
std::signal(SIGTERM, &fims::WriteAtExit); |
| 70 |
} |
|
| 71 | ||
| 72 |
/** |
|
| 73 |
* @brief Creates the TMB model object and adds interface objects to it. |
|
| 74 |
* |
|
| 75 |
* @details |
|
| 76 |
* This function is called within `initialize_fims()` from R and is not |
|
| 77 |
* typically called by the user directly. |
|
| 78 |
*/ |
|
| 79 | ! |
bool CreateTMBModel() {
|
| 80 | ! |
init_logging(); |
| 81 | ||
| 82 | ! |
FIMS_INFO_LOG("adding FIMS objects to TMB");
|
| 83 | ! |
for (size_t i = 0; i < FIMSRcppInterfaceBase::fims_interface_objects.size(); |
| 84 | ! |
i++) {
|
| 85 | ! |
FIMSRcppInterfaceBase::fims_interface_objects[i]->add_to_fims_tmb(); |
| 86 |
} |
|
| 87 | ||
| 88 |
// base model |
|
| 89 |
std::shared_ptr<fims_info::Information < TMB_FIMS_REAL_TYPE>> d0 = |
|
| 90 | ! |
fims_info::Information<TMB_FIMS_REAL_TYPE>::GetInstance(); |
| 91 | ! |
d0->CreateModel(); |
| 92 | ||
| 93 |
// first-order derivative |
|
| 94 |
std::shared_ptr<fims_info::Information < TMB_FIMS_FIRST_ORDER>> d1 = |
|
| 95 | ! |
fims_info::Information<TMB_FIMS_FIRST_ORDER>::GetInstance(); |
| 96 | ! |
d1->CreateModel(); |
| 97 | ||
| 98 |
// second-order derivative |
|
| 99 |
std::shared_ptr<fims_info::Information < TMB_FIMS_SECOND_ORDER>> d2 = |
|
| 100 | ! |
fims_info::Information<TMB_FIMS_SECOND_ORDER>::GetInstance(); |
| 101 | ! |
d2->CreateModel(); |
| 102 | ||
| 103 |
// third-order derivative |
|
| 104 |
std::shared_ptr<fims_info::Information < TMB_FIMS_THIRD_ORDER>> d3 = |
|
| 105 | ! |
fims_info::Information<TMB_FIMS_THIRD_ORDER>::GetInstance(); |
| 106 | ! |
d3->CreateModel(); |
| 107 | ||
| 108 |
return true; |
|
| 109 |
} |
|
| 110 | ||
| 111 |
/** |
|
| 112 |
* @brief Loops through the Rcpp Interface objects and extracts derived |
|
| 113 |
* quantities. Updates parameter estimates from model core objects. |
|
| 114 |
*/ |
|
| 115 | ! |
void finalize_objects(Rcpp::NumericVector p) {
|
| 116 | ! |
FIMS_function_parameters = p; |
| 117 | ||
| 118 |
std::shared_ptr<fims_info::Information < double>> information = |
|
| 119 | ! |
fims_info::Information<double>::GetInstance(); |
| 120 | ||
| 121 |
std::shared_ptr<fims_model::Model < double>> model = |
|
| 122 | ! |
fims_model::Model<double>::GetInstance(); |
| 123 | ||
| 124 | ! |
for (size_t i = 0; i < information->fixed_effects_parameters.size(); i++) {
|
| 125 | ! |
*information->fixed_effects_parameters[i] = p[i]; |
| 126 |
} |
|
| 127 | ||
| 128 | ! |
model->Evaluate(); |
| 129 | ||
| 130 | ! |
Rcpp::Function f = Rcpp::as<Rcpp::Function>(FIMS_objective_function); |
| 131 | ! |
Rcpp::Function g = Rcpp::as<Rcpp::Function>(FIMS_gradient_function); |
| 132 | ! |
double ret = Rcpp::as<double>(f(p)); |
| 133 | ! |
Rcpp::NumericVector grad = Rcpp::as<Rcpp::NumericVector>(g(p)); |
| 134 | ||
| 135 | ! |
FIMS_function_value = ret; |
| 136 | ! |
FIMS_function_gradient = grad; |
| 137 | ! |
Rcpp::Rcout << "Final value = " << FIMS_function_value << "\nGradient: \n"; |
| 138 | ! |
double maxgc = -999; |
| 139 | ! |
for (R_xlen_t i = 0; i < FIMS_function_gradient.size(); i++) {
|
| 140 | ! |
if (std::fabs(FIMS_function_gradient[i]) > maxgc) {
|
| 141 | ! |
maxgc = std::fabs(FIMS_function_gradient[i]); |
| 142 |
} |
|
| 143 |
} |
|
| 144 | ! |
FIMS_mgc_value = maxgc; |
| 145 | ||
| 146 | ! |
for (size_t i = 0; i < FIMSRcppInterfaceBase::fims_interface_objects.size(); |
| 147 | ! |
i++) {
|
| 148 | ! |
FIMSRcppInterfaceBase::fims_interface_objects[i]->finalize(); |
| 149 |
} |
|
| 150 |
} |
|
| 151 | ||
| 152 |
/** |
|
| 153 |
* @brief Finalizes a FIMS model by updating the parameter set. This function |
|
| 154 |
* evaluates the objective function and the gradient with the given parameter |
|
| 155 |
* set. |
|
| 156 |
* @param obj Either a list containing \"fn\" and \"gr\", or a list containing |
|
| 157 |
* two separate lists \"obj\" and \"opt\", \"obj\" should contain \"fn\" and |
|
| 158 |
* \"gr\", \"opt\" should contain \"par\". In the second case, the second |
|
| 159 |
* function argument is expected to be null and ignored. |
|
| 160 |
* TODO: Remove the ability to take a single list. |
|
| 161 |
* @param opt A list containing \"par\". |
|
| 162 |
*/ |
|
| 163 | ! |
void finalize_fims(Rcpp::Nullable< Rcpp::List> obj = R_NilValue, |
| 164 |
Rcpp::Nullable< Rcpp::List> opt = R_NilValue) {
|
|
| 165 | ||
| 166 | ! |
bool valid_list = true; |
| 167 | ! |
Rcpp::NumericVector parameters; |
| 168 | ||
| 169 |
//check and handle the first argument. |
|
| 170 | ! |
if (!Rf_isNull(obj.get())) {
|
| 171 | ! |
Rcpp::List input_list = Rcpp::as<Rcpp::List>(obj); |
| 172 | ! |
if (input_list.containsElementNamed("obj")
|
| 173 | ! |
&& input_list.containsElementNamed("opt")) {
|
| 174 | ! |
Rcpp::List obj_list = input_list["obj"]; |
| 175 | ! |
Rcpp::List opt_list = input_list["opt"]; |
| 176 | ||
| 177 | ! |
if (obj_list.containsElementNamed("fn")) {
|
| 178 | ! |
FIMS_objective_function = obj_list["fn"]; |
| 179 |
} else {
|
|
| 180 | ! |
valid_list = false; |
| 181 | ! |
FIMS_ERROR_LOG("Invalid call, \"fn\" not found in argument list.");
|
| 182 |
} |
|
| 183 | ||
| 184 | ! |
if (obj_list.containsElementNamed("gr")) {
|
| 185 | ! |
FIMS_gradient_function = obj_list["gr"]; |
| 186 |
} else {
|
|
| 187 | ! |
valid_list = false; |
| 188 | ! |
FIMS_ERROR_LOG("Invalid call, \"gr\" not found in argument list.");
|
| 189 |
} |
|
| 190 | ||
| 191 | ! |
if (opt_list.containsElementNamed("par")) {
|
| 192 | ! |
parameters = Rcpp::as<Rcpp::NumericVector>(opt_list["par"]); |
| 193 |
} else {
|
|
| 194 | ! |
valid_list = false; |
| 195 | ! |
FIMS_ERROR_LOG("Invalid call, \"par\" not found in argument list.");
|
| 196 |
} |
|
| 197 | ||
| 198 |
//if we are here, a single argument was used. if it contains the |
|
| 199 |
//expected elements, the list is valid and objects can be finalize. |
|
| 200 | ! |
if (valid_list) {
|
| 201 | ! |
finalize_objects(parameters); |
| 202 | ! |
FIMS_finalized = true; |
| 203 | ! |
return; |
| 204 |
} else {
|
|
| 205 | ! |
return; |
| 206 |
} |
|
| 207 | ||
| 208 | ! |
} else {//two arguments?
|
| 209 | ! |
if (input_list.containsElementNamed("fn")) {
|
| 210 | ! |
FIMS_objective_function = input_list["fn"]; |
| 211 |
} else {
|
|
| 212 | ! |
valid_list = false; |
| 213 | ! |
FIMS_ERROR_LOG("Invalid call, \"fn\" not found in argument list.");
|
| 214 |
} |
|
| 215 | ||
| 216 | ! |
if (input_list.containsElementNamed("gr")) {
|
| 217 | ! |
FIMS_gradient_function = input_list["gr"]; |
| 218 |
} else {
|
|
| 219 | ! |
valid_list = false; |
| 220 | ! |
FIMS_ERROR_LOG("Invalid call, \"gr\" not found in argument list.");
|
| 221 |
} |
|
| 222 |
} |
|
| 223 |
} |
|
| 224 | ||
| 225 |
//check second argument. |
|
| 226 | ! |
if (!Rf_isNull(opt.get())) {
|
| 227 | ||
| 228 | ! |
Rcpp::List input_list = Rcpp::as<Rcpp::List>(opt); |
| 229 | ||
| 230 | ! |
if (input_list.containsElementNamed("par")) {
|
| 231 | ! |
parameters = Rcpp::as<Rcpp::NumericVector>(input_list["par"]); |
| 232 |
} else {
|
|
| 233 | ! |
valid_list = false; |
| 234 | ! |
FIMS_ERROR_LOG("Invalid call, \"par\" not found in argument list.");
|
| 235 | ||
| 236 |
} |
|
| 237 |
} else {
|
|
| 238 | ! |
valid_list = false; |
| 239 |
} |
|
| 240 | ||
| 241 |
//if we're here, two arguments were given. If they contain the expected |
|
| 242 |
//elements, the lists are valid and objects can be finalized. |
|
| 243 | ! |
if (valid_list) {
|
| 244 | ! |
finalize_objects(parameters); |
| 245 | ! |
FIMS_finalized = true; |
| 246 |
} |
|
| 247 |
} |
|
| 248 | ||
| 249 |
/** |
|
| 250 |
* @brief Extracts the derived quantities from model objects. |
|
| 251 |
*/ |
|
| 252 | ! |
std::string get_output() {
|
| 253 | ! |
std::string ret; |
| 254 | ! |
if (FIMS_finalized) {
|
| 255 | ! |
auto now = std::chrono::system_clock::now(); |
| 256 | ! |
std::time_t now_time = std::chrono::system_clock::to_time_t(now); |
| 257 | ! |
std::string ctime_no_newline = strtok(ctime(&now_time), "\n"); |
| 258 |
std::shared_ptr<fims_info::Information < double>> info = |
|
| 259 | ! |
fims_info::Information<double>::GetInstance(); |
| 260 | ! |
std::stringstream ss; |
| 261 | ! |
ss << "{\n";
|
| 262 | ! |
ss << "\"timestamp\": \"" << ctime_no_newline << "\",\n"; |
| 263 | ! |
ss << "\"nyears\":" << info->nyears << ",\n"; |
| 264 | ! |
ss << "\"nseasons\":" << info->nseasons << ",\n"; |
| 265 | ! |
ss << "\"nages\":" << info->nages << ",\n"; |
| 266 | ! |
ss << "\"finalized\":" << FIMS_finalized << ",\n"; |
| 267 | ! |
ss << "\"objective_function_value\": " << FIMS_function_value << ",\n"; |
| 268 | ! |
ss << "\"max_gradient_component\": " << FIMS_mgc_value << ",\n"; |
| 269 | ! |
ss << "\"final_gradient\": ["; |
| 270 | ! |
if (FIMS_function_gradient.size() > 0) {
|
| 271 | ! |
for (R_xlen_t i = 0; i < FIMS_function_gradient.size() - 1; i++) {
|
| 272 | ! |
ss << FIMS_function_gradient[i] << ", "; |
| 273 |
} |
|
| 274 | ! |
ss << FIMS_function_gradient[FIMS_function_gradient.size() - 1] << "],\n"; |
| 275 |
} else {
|
|
| 276 | ! |
ss << "],"; |
| 277 |
} |
|
| 278 | ! |
size_t length = FIMSRcppInterfaceBase::fims_interface_objects.size(); |
| 279 | ! |
for (size_t i = 0; i < length - 1; i++) {
|
| 280 | ! |
ss << FIMSRcppInterfaceBase::fims_interface_objects[i]->to_json() << ",\n"; |
| 281 |
} |
|
| 282 | ||
| 283 | ! |
ss << FIMSRcppInterfaceBase::fims_interface_objects[length - 1]->to_json() << "\n}"; |
| 284 | ||
| 285 | ! |
ret = fims::JsonParser::PrettyFormatJSON(ss.str()); |
| 286 |
} else {
|
|
| 287 | ! |
Rcpp::Rcout << "Invalid request to \"get_output()\". Please call finalize() first."; |
| 288 |
} |
|
| 289 | ! |
return ret; |
| 290 |
} |
|
| 291 | ||
| 292 |
/** |
|
| 293 |
* @brief Gets the fixed parameters vector object. |
|
| 294 |
* |
|
| 295 |
* @return Rcpp::NumericVector |
|
| 296 |
*/ |
|
| 297 | ! |
Rcpp::NumericVector get_fixed_parameters_vector() {
|
| 298 |
// base model |
|
| 299 |
std::shared_ptr<fims_info::Information < TMB_FIMS_REAL_TYPE>> d0 = |
|
| 300 | ! |
fims_info::Information<TMB_FIMS_REAL_TYPE>::GetInstance(); |
| 301 | ||
| 302 | ! |
Rcpp::NumericVector p; |
| 303 | ||
| 304 | ! |
for (size_t i = 0; i < d0->fixed_effects_parameters.size(); i++) {
|
| 305 | ! |
p.push_back(*d0->fixed_effects_parameters[i]); |
| 306 |
} |
|
| 307 | ||
| 308 | ! |
return p; |
| 309 |
} |
|
| 310 | ||
| 311 |
/** |
|
| 312 |
* @brief Gets the random parameters vector object. |
|
| 313 |
* |
|
| 314 |
* @return Rcpp::NumericVector |
|
| 315 |
*/ |
|
| 316 | ! |
Rcpp::NumericVector get_random_parameters_vector() {
|
| 317 |
// base model |
|
| 318 |
std::shared_ptr<fims_info::Information < TMB_FIMS_REAL_TYPE>> d0 = |
|
| 319 | ! |
fims_info::Information<TMB_FIMS_REAL_TYPE>::GetInstance(); |
| 320 | ||
| 321 | ! |
Rcpp::NumericVector p; |
| 322 | ||
| 323 | ! |
for (size_t i = 0; i < d0->random_effects_parameters.size(); i++) {
|
| 324 | ! |
p.push_back(*d0->random_effects_parameters[i]); |
| 325 |
} |
|
| 326 | ||
| 327 | ! |
return p; |
| 328 |
} |
|
| 329 | ||
| 330 |
/** |
|
| 331 |
* @brief Gets the parameter names object. |
|
| 332 |
* |
|
| 333 |
* @param pars |
|
| 334 |
* @return Rcpp::List |
|
| 335 |
*/ |
|
| 336 | ! |
Rcpp::List get_parameter_names(Rcpp::List pars) {
|
| 337 |
// base model |
|
| 338 |
std::shared_ptr<fims_info::Information < TMB_FIMS_REAL_TYPE>> d0 = |
|
| 339 | ! |
fims_info::Information<TMB_FIMS_REAL_TYPE>::GetInstance(); |
| 340 | ||
| 341 | ! |
pars.attr("names") = d0->parameter_names;
|
| 342 | ||
| 343 | ! |
return pars; |
| 344 |
} |
|
| 345 | ||
| 346 |
/** |
|
| 347 |
* @brief Clears the internal objects. |
|
| 348 |
* |
|
| 349 |
* @tparam Type |
|
| 350 |
*/ |
|
| 351 |
template <typename Type> |
|
| 352 | ! |
void clear_internal() {
|
| 353 |
std::shared_ptr<fims_info::Information < Type>> d0 = |
|
| 354 | ! |
fims_info::Information<Type>::GetInstance(); |
| 355 | ! |
d0->Clear(); |
| 356 |
} |
|
| 357 | ||
| 358 |
/** |
|
| 359 |
* @brief Clears the vector of independent variables. |
|
| 360 |
*/ |
|
| 361 | ! |
void clear() {
|
| 362 |
// rcpp_interface_base.hpp |
|
| 363 | ! |
FIMSRcppInterfaceBase::fims_interface_objects.clear(); |
| 364 | ||
| 365 |
//Parameter and ParameterVector |
|
| 366 | ! |
Parameter::id_g = 1; |
| 367 | ! |
ParameterVector::id_g = 1; |
| 368 |
// rcpp_data.hpp |
|
| 369 | ! |
DataInterfaceBase::id_g = 1; |
| 370 | ! |
DataInterfaceBase::live_objects.clear(); |
| 371 | ||
| 372 | ! |
AgeCompDataInterface::id_g = 1; |
| 373 | ! |
AgeCompDataInterface::live_objects.clear(); |
| 374 | ||
| 375 | ! |
LengthCompDataInterface::id_g = 1; |
| 376 | ! |
LengthCompDataInterface::live_objects.clear(); |
| 377 | ||
| 378 | ! |
IndexDataInterface::id_g = 1; |
| 379 | ! |
IndexDataInterface::live_objects.clear(); |
| 380 | ||
| 381 |
// rcpp_fleets.hpp |
|
| 382 | ! |
FleetInterfaceBase::id_g = 1; |
| 383 | ! |
FleetInterfaceBase::live_objects.clear(); |
| 384 | ||
| 385 | ! |
FleetInterface::id_g = 1; |
| 386 | ! |
FleetInterface::live_objects.clear(); |
| 387 | ||
| 388 |
// rcpp_growth.hpp |
|
| 389 | ! |
GrowthInterfaceBase::id_g = 1; |
| 390 | ! |
GrowthInterfaceBase::live_objects.clear(); |
| 391 | ||
| 392 | ! |
EWAAGrowthInterface::id_g = 1; |
| 393 | ! |
EWAAGrowthInterface::live_objects.clear(); |
| 394 | ||
| 395 |
// rcpp_maturity.hpp |
|
| 396 | ! |
MaturityInterfaceBase::id_g = 1; |
| 397 | ! |
MaturityInterfaceBase::live_objects.clear(); |
| 398 | ||
| 399 | ! |
LogisticMaturityInterface::id_g = 1; |
| 400 | ! |
LogisticMaturityInterface::live_objects.clear(); |
| 401 | ||
| 402 |
// rcpp_population.hpp |
|
| 403 | ! |
PopulationInterfaceBase::id_g = 1; |
| 404 | ! |
PopulationInterfaceBase::live_objects.clear(); |
| 405 | ||
| 406 | ! |
PopulationInterface::id_g = 1; |
| 407 | ! |
PopulationInterface::live_objects.clear(); |
| 408 | ||
| 409 |
// rcpp_recruitment.hpp |
|
| 410 | ! |
RecruitmentInterfaceBase::id_g = 1; |
| 411 | ! |
RecruitmentInterfaceBase::live_objects.clear(); |
| 412 | ||
| 413 | ! |
BevertonHoltRecruitmentInterface::id_g = 1; |
| 414 | ! |
BevertonHoltRecruitmentInterface::live_objects.clear(); |
| 415 | ||
| 416 |
// rcpp_selectivity.hpp |
|
| 417 | ! |
SelectivityInterfaceBase::id_g = 1; |
| 418 | ! |
SelectivityInterfaceBase::live_objects.clear(); |
| 419 | ||
| 420 | ! |
LogisticSelectivityInterface::id_g = 1; |
| 421 | ! |
LogisticSelectivityInterface::live_objects.clear(); |
| 422 | ||
| 423 | ! |
DoubleLogisticSelectivityInterface::id_g = 1; |
| 424 | ! |
DoubleLogisticSelectivityInterface::live_objects.clear(); |
| 425 | ||
| 426 |
// rcpp_distribution.hpp |
|
| 427 | ! |
DistributionsInterfaceBase::id_g = 1; |
| 428 | ! |
DistributionsInterfaceBase::live_objects.clear(); |
| 429 | ||
| 430 | ! |
DnormDistributionsInterface::id_g = 1; |
| 431 | ! |
DnormDistributionsInterface::live_objects.clear(); |
| 432 | ||
| 433 | ! |
DlnormDistributionsInterface::id_g = 1; |
| 434 | ! |
DlnormDistributionsInterface::live_objects.clear(); |
| 435 | ||
| 436 | ! |
DmultinomDistributionsInterface::id_g = 1; |
| 437 | ! |
DmultinomDistributionsInterface::live_objects.clear(); |
| 438 | ||
| 439 | ! |
clear_internal<TMB_FIMS_REAL_TYPE>(); |
| 440 | ! |
clear_internal<TMB_FIMS_FIRST_ORDER>(); |
| 441 | ! |
clear_internal<TMB_FIMS_SECOND_ORDER>(); |
| 442 | ! |
clear_internal<TMB_FIMS_THIRD_ORDER>(); |
| 443 | ||
| 444 | ! |
fims::FIMSLog::fims_log->clear(); |
| 445 | ||
| 446 | ! |
FIMS_finalized = false; |
| 447 |
} |
|
| 448 | ||
| 449 |
/** |
|
| 450 |
* @brief Gets the log entries as a string in JSON format. |
|
| 451 |
*/ |
|
| 452 | ! |
std::string get_log() {
|
| 453 | ! |
return fims::FIMSLog::fims_log->get_log(); |
| 454 |
} |
|
| 455 | ||
| 456 |
/** |
|
| 457 |
* @brief Gets the error entries from the log as a string in JSON format. |
|
| 458 |
*/ |
|
| 459 | ! |
std::string get_log_errors() {
|
| 460 | ! |
return fims::FIMSLog::fims_log->get_errors(); |
| 461 |
} |
|
| 462 | ||
| 463 |
/** |
|
| 464 |
* @brief Gets the warning entries from the log as a string in JSON format. |
|
| 465 |
*/ |
|
| 466 | ! |
std::string get_log_warnings() {
|
| 467 | ! |
return fims::FIMSLog::fims_log->get_warnings(); |
| 468 |
} |
|
| 469 | ||
| 470 |
/** |
|
| 471 |
* @brief Gets the info entries from the log as a string in JSON format. |
|
| 472 |
*/ |
|
| 473 | ! |
std::string get_log_info() {
|
| 474 | ! |
return fims::FIMSLog::fims_log->get_info(); |
| 475 |
} |
|
| 476 | ||
| 477 |
/** |
|
| 478 |
* @brief Gets log entries by module as a string in JSON format. |
|
| 479 |
*/ |
|
| 480 | ! |
std::string get_log_module(const std::string& module) {
|
| 481 | ! |
return fims::FIMSLog::fims_log->get_module(module); |
| 482 |
} |
|
| 483 | ||
| 484 |
/** |
|
| 485 |
* @brief If true, writes the log on exit. |
|
| 486 |
*/ |
|
| 487 | ! |
void write_log(bool write) {
|
| 488 | ! |
FIMS_INFO_LOG("Setting FIMS write log: " + fims::to_string(write));
|
| 489 | ! |
fims::FIMSLog::fims_log->write_on_exit = write; |
| 490 |
} |
|
| 491 | ||
| 492 |
/** |
|
| 493 |
* @brief Sets the path for the log file to be written to. |
|
| 494 |
*/ |
|
| 495 | ! |
void set_log_path(const std::string& path) {
|
| 496 | ! |
FIMS_INFO_LOG("Setting FIMS log path: " + path);
|
| 497 | ! |
fims::FIMSLog::fims_log->set_path(path); |
| 498 |
} |
|
| 499 | ||
| 500 |
/** |
|
| 501 |
* @brief If true, throws a runtime exception when an error is logged. |
|
| 502 |
*/ |
|
| 503 | ! |
void set_log_throw_on_error(bool throw_on_error) {
|
| 504 | ! |
fims::FIMSLog::fims_log->throw_on_error = throw_on_error; |
| 505 |
} |
|
| 506 | ||
| 507 |
/** |
|
| 508 |
* @brief Adds an info entry to the log from the R environment. |
|
| 509 |
*/ |
|
| 510 | ! |
void log_info(std::string log_entry) {
|
| 511 | ! |
fims::FIMSLog::fims_log->info_message(log_entry, -1, "R_env", "R_script_entry"); |
| 512 |
} |
|
| 513 | ||
| 514 |
/** |
|
| 515 |
* @brief Adds a warning entry to the log from the R environment. |
|
| 516 |
*/ |
|
| 517 | ! |
void log_warning(std::string log_entry) {
|
| 518 | ! |
fims::FIMSLog::fims_log->warning_message(log_entry, -1, "R_env", "R_script_entry"); |
| 519 |
} |
|
| 520 | ||
| 521 |
/** |
|
| 522 |
* @brief Escapes quotations. |
|
| 523 |
* |
|
| 524 |
* @param input A string. |
|
| 525 |
* @return std::string |
|
| 526 |
*/ |
|
| 527 | ! |
std::string escapeQuotes(const std::string& input) {
|
| 528 | ! |
std::string result = input; |
| 529 | ! |
std::string search = "\""; |
| 530 | ! |
std::string replace = "\\\""; |
| 531 | ||
| 532 |
// Find each occurrence of `"` and replace it with `\"` |
|
| 533 | ! |
size_t pos = result.find(search); |
| 534 | ! |
while (pos != std::string::npos) {
|
| 535 | ! |
result.replace(pos, search.size(), replace); |
| 536 | ! |
pos = result.find(search, pos + replace.size()); // Move past the replaced position |
| 537 |
} |
|
| 538 | ! |
return result; |
| 539 |
} |
|
| 540 | ||
| 541 |
/** |
|
| 542 |
* @brief Adds a error entry to the log from the R environment. |
|
| 543 |
*/ |
|
| 544 | ! |
void log_error(std::string log_entry) {
|
| 545 | ! |
std::stringstream ss; |
| 546 | ! |
ss << "capture.output(traceback(4))"; |
| 547 |
SEXP expression, result; |
|
| 548 |
ParseStatus status; |
|
| 549 | ||
| 550 | ! |
PROTECT(expression = R_ParseVector(Rf_mkString(ss.str().c_str()), 1, &status, R_NilValue)); |
| 551 | ! |
if (status != PARSE_OK) {
|
| 552 | ! |
Rcpp::Rcout << "Error parsing expression" << std::endl; |
| 553 | ! |
UNPROTECT(1); |
| 554 |
} |
|
| 555 | ! |
Rcpp::Rcout << "before call."; |
| 556 | ! |
PROTECT(result = Rf_eval(VECTOR_ELT(expression, 0), R_GlobalEnv)); |
| 557 | ! |
Rcpp::Rcout << "after call."; |
| 558 | ! |
UNPROTECT(2); |
| 559 | ! |
std::stringstream ss_ret; |
| 560 | ! |
ss_ret << "traceback: "; |
| 561 | ! |
for (int j = 0; j < LENGTH(result); j++) {
|
| 562 | ! |
std::string str(CHAR(STRING_ELT(result, j))); |
| 563 | ! |
ss_ret << escapeQuotes(str) << "\\n"; |
| 564 |
} |
|
| 565 | ||
| 566 | ! |
std::string ret = ss_ret.str(); //"find error";//Rcpp::as<std::string>(result); |
| 567 | ||
| 568 | ! |
fims::FIMSLog::fims_log->error_message(log_entry, -1, "R_env", ret.c_str()); |
| 569 |
} |
|
| 570 | ||
| 571 |
RCPP_EXPOSED_CLASS(Parameter) |
|
| 572 |
RCPP_EXPOSED_CLASS(ParameterVector) |
|
| 573 | ||
| 574 |
/** |
|
| 575 |
* @brief The `fims` Rcpp module construct, providing declarative code of what |
|
| 576 |
* the module exposes to R. |
|
| 577 |
* |
|
| 578 |
* @details Each element included in the module should have a name, a pointer, |
|
| 579 |
* and a description separated by commas in that order. Both the name and the |
|
| 580 |
* description should be wrapped in quotes. The description is printed to the |
|
| 581 |
* screen when the R function `methods::show()` is used on the object. The |
|
| 582 |
* available description should exactly match the information found in the |
|
| 583 |
* brief tag where the function, class, etc. is documented. See the Rcpp |
|
| 584 |
* vignette for more information on documenting modules, particularly how to |
|
| 585 |
* include lists for parameters to a function. Each of the functions included |
|
| 586 |
* in this module should be exported by manually exporting them in |
|
| 587 |
* R/FIMS-package.R. |
|
| 588 |
* |
|
| 589 |
*/ |
|
| 590 | 4x |
RCPP_MODULE(fims) {
|
| 591 | 2x |
Rcpp::function( |
| 592 |
"CreateTMBModel", &CreateTMBModel, |
|
| 593 |
"Creates the TMB model object and adds interface objects to it."); |
|
| 594 | 2x |
Rcpp::function( |
| 595 |
"finalize", &finalize_fims, |
|
| 596 |
"Extracts the derived quantities from `Information` to the Rcpp object."); |
|
| 597 | 2x |
Rcpp::function( |
| 598 |
"get_output", &get_output, |
|
| 599 |
"Extracts the derived quantities from model objects."); |
|
| 600 | 2x |
Rcpp::function( |
| 601 |
"get_fixed", &get_fixed_parameters_vector, |
|
| 602 |
"Gets the fixed parameters vector object."); |
|
| 603 | 2x |
Rcpp::function( |
| 604 |
"get_random", &get_random_parameters_vector, |
|
| 605 |
"Gets the random parameters vector object."); |
|
| 606 | 2x |
Rcpp::function( |
| 607 |
"get_parameter_names", &get_parameter_names, |
|
| 608 |
"Gets the parameter names object."); |
|
| 609 | 2x |
Rcpp::function( |
| 610 |
"clear", clear, |
|
| 611 |
"Clears all pointers/references of a FIMS model"); |
|
| 612 | 2x |
Rcpp::function( |
| 613 |
"get_log", get_log, |
|
| 614 |
"Gets the log entries as a string in JSON format."); |
|
| 615 | 2x |
Rcpp::function( |
| 616 |
"get_log_errors", get_log_errors, |
|
| 617 |
"Gets the error entries from the log as a string in JSON format."); |
|
| 618 | 2x |
Rcpp::function( |
| 619 |
"get_log_warnings", get_log_warnings, |
|
| 620 |
"Gets the warning entries from the log as a string in JSON format."); |
|
| 621 | 2x |
Rcpp::function( |
| 622 |
"get_log_info", get_log_info, |
|
| 623 |
"Gets the info entries from the log as a string in JSON format."); |
|
| 624 | 2x |
Rcpp::function( |
| 625 |
"get_log_module", get_log_module, |
|
| 626 |
"Gets log entries by module as a string in JSON format."); |
|
| 627 | 2x |
Rcpp::function( |
| 628 |
"write_log", write_log, |
|
| 629 |
"If true, writes the log on exit."); |
|
| 630 | 2x |
Rcpp::function( |
| 631 |
"set_log_path", set_log_path, |
|
| 632 |
"Sets the path for the log file to be written to."); |
|
| 633 | 2x |
Rcpp::function( |
| 634 |
"init_logging", init_logging, |
|
| 635 |
"Initializes the logging system, setting all signal handling."); |
|
| 636 | 2x |
Rcpp::function( |
| 637 |
"set_log_throw_on_error", set_log_throw_on_error, |
|
| 638 |
"If true, throws a runtime exception when an error is logged."); |
|
| 639 | 2x |
Rcpp::function( |
| 640 |
"log_info", log_info, |
|
| 641 |
"Adds an info entry to the log from the R environment."); |
|
| 642 | 2x |
Rcpp::function( |
| 643 |
"log_warning", log_warning, |
|
| 644 |
"Adds a warning entry to the log from the R environment."); |
|
| 645 | 2x |
Rcpp::function( |
| 646 |
"log_error", log_error, |
|
| 647 |
"Adds a error entry to the log from the R environment."); |
|
| 648 | 4x |
Rcpp::class_<Parameter>( |
| 649 |
"Parameter", |
|
| 650 |
"An RcppInterface class that defines the Parameter class.") |
|
| 651 | 2x |
.constructor() |
| 652 | 2x |
.constructor<double>() |
| 653 | 2x |
.constructor<Parameter>() |
| 654 | 2x |
.field( |
| 655 |
"value", &Parameter::initial_value_m, |
|
| 656 |
"A numeric value specifying the initial value of the parameter.") |
|
| 657 | 2x |
.field( |
| 658 |
"value", &Parameter::final_value_m, |
|
| 659 |
"A numeric value specifying the final value of the parameter.") |
|
| 660 | 2x |
.field( |
| 661 |
"min", &Parameter::min_m, |
|
| 662 |
"A numeric value specifying the minimum possible parameter value, where the default is negative infinity.") |
|
| 663 | 2x |
.field( |
| 664 |
"max", &Parameter::max_m, |
|
| 665 |
"A numeric value specifying the maximum possible parameter value, where the default is positive infinity.") |
|
| 666 | 2x |
.field( |
| 667 |
"id", &Parameter::id_m, |
|
| 668 |
"unique id for parameter class") |
|
| 669 | 2x |
.field( |
| 670 |
"is_random_effect", &Parameter::is_random_effect_m, |
|
| 671 |
"A boolean indicating whether or not the parameter is a random effect; the default is FALSE.") |
|
| 672 | 2x |
.field( |
| 673 |
"estimated", &Parameter::estimated_m, |
|
| 674 |
"A boolean indicating whether or not the parameter is estimated; the default is FALSE."); |
|
| 675 | ||
| 676 | 4x |
Rcpp::class_<ParameterVector>( |
| 677 |
"ParameterVector", |
|
| 678 |
"An RcppInterface class that defines the ParameterVector class.") |
|
| 679 | 2x |
.constructor() |
| 680 | 2x |
.constructor<size_t>() |
| 681 | 2x |
.constructor<Rcpp::NumericVector, size_t>() |
| 682 | 2x |
.method("get", &ParameterVector::get,
|
| 683 |
"An internal accessor for calling a position of a ParameterVector from R.") |
|
| 684 | 2x |
.method("set", &ParameterVector::set,
|
| 685 |
"An internal setter for setting a position of a ParameterVector from R.") |
|
| 686 | 2x |
.method("show", &ParameterVector::show,
|
| 687 |
"The printing methods for a ParameterVector.") |
|
| 688 | 2x |
.method("at", &ParameterVector::at,
|
| 689 |
"Returns a Parameter at the indicated position given the index argument.") |
|
| 690 | 2x |
.method("size", &ParameterVector::size,
|
| 691 |
"Returns the size of a ParameterVector.") |
|
| 692 | 2x |
.method("resize", &ParameterVector::resize,
|
| 693 |
"Resizes a ParameterVector to the desired length.") |
|
| 694 | 2x |
.method("set_all_estimable", &ParameterVector::set_all_estimable,
|
| 695 |
"Sets all Parameters within a ParameterVector as estimable.") |
|
| 696 | 2x |
.method("set_all_random", &ParameterVector::set_all_random,
|
| 697 |
"Sets all Parameters within a ParameterVector as random effects.") |
|
| 698 | 2x |
.method("fill", &ParameterVector::fill,
|
| 699 |
"Sets the value of all Parameters in the ParameterVector to the provided value.") |
|
| 700 | 2x |
.method("get_id", &ParameterVector::get_id,
|
| 701 |
"Gets the ID of the ParameterVector object."); |
|
| 702 | ||
| 703 | 4x |
Rcpp::class_<BevertonHoltRecruitmentInterface>("BevertonHoltRecruitment")
|
| 704 | 2x |
.constructor() |
| 705 | 2x |
.field("logit_steep", &BevertonHoltRecruitmentInterface::logit_steep)
|
| 706 | 2x |
.field("log_rzero", &BevertonHoltRecruitmentInterface::log_rzero)
|
| 707 | 2x |
.field("log_devs", &BevertonHoltRecruitmentInterface::log_devs)
|
| 708 | 2x |
.field("estimate_log_devs",
|
| 709 |
&BevertonHoltRecruitmentInterface::estimate_log_devs) |
|
| 710 | 2x |
.method("get_id", &BevertonHoltRecruitmentInterface::get_id)
|
| 711 | 2x |
.method("evaluate", &BevertonHoltRecruitmentInterface::evaluate);
|
| 712 | ||
| 713 | 4x |
Rcpp::class_<FleetInterface>("Fleet")
|
| 714 | 2x |
.constructor() |
| 715 | 2x |
.field("is_survey", &FleetInterface::is_survey)
|
| 716 | 2x |
.field("log_q", &FleetInterface::log_q)
|
| 717 | 2x |
.field("log_Fmort", &FleetInterface::log_Fmort)
|
| 718 | 2x |
.field("nages", &FleetInterface::nages)
|
| 719 | 2x |
.field("nyears", &FleetInterface::nyears)
|
| 720 | 2x |
.field("nlengths", &FleetInterface::nlengths)
|
| 721 | 2x |
.field("estimate_q", &FleetInterface::estimate_q)
|
| 722 | 2x |
.field("random_q", &FleetInterface::random_q)
|
| 723 | 2x |
.field("log_expected_index", &FleetInterface::log_expected_index)
|
| 724 | 2x |
.field("proportion_catch_numbers_at_age", &FleetInterface::proportion_catch_numbers_at_age)
|
| 725 | 2x |
.field("proportion_catch_numbers_at_length", &FleetInterface::proportion_catch_numbers_at_length)
|
| 726 | 2x |
.field("age_length_conversion_matrix", &FleetInterface::age_length_conversion_matrix)
|
| 727 | 2x |
.method("SetObservedAgeCompData", &FleetInterface::SetObservedAgeCompData)
|
| 728 | 2x |
.method("GetObservedAgeCompDataID", &FleetInterface::GetObservedAgeCompDataID)
|
| 729 | 2x |
.method("SetObservedLengthCompData", &FleetInterface::SetObservedLengthCompData)
|
| 730 | 2x |
.method("GetObservedLengthCompDataID", &FleetInterface::GetObservedLengthCompDataID)
|
| 731 | 2x |
.method("SetObservedIndexData", &FleetInterface::SetObservedIndexData)
|
| 732 | 2x |
.method("GetObservedIndexDataID", &FleetInterface::GetObservedIndexDataID)
|
| 733 | 2x |
.method("SetSelectivity", &FleetInterface::SetSelectivity);
|
| 734 | ||
| 735 | 4x |
Rcpp::class_<AgeCompDataInterface>("AgeComp")
|
| 736 | 2x |
.constructor<int, int>() |
| 737 | 2x |
.field("age_comp_data", &AgeCompDataInterface::age_comp_data)
|
| 738 | 2x |
.method("get_id", &AgeCompDataInterface::get_id);
|
| 739 | ||
| 740 | 4x |
Rcpp::class_<LengthCompDataInterface>("LengthComp")
|
| 741 | 2x |
.constructor<int, int>() |
| 742 | 2x |
.field("length_comp_data", &LengthCompDataInterface::length_comp_data)
|
| 743 | 2x |
.method("get_id", &LengthCompDataInterface::get_id);
|
| 744 | ||
| 745 | 4x |
Rcpp::class_<IndexDataInterface>("Index")
|
| 746 | 2x |
.constructor<int>() |
| 747 | 2x |
.field("index_data", &IndexDataInterface::index_data)
|
| 748 | 2x |
.method("get_id", &IndexDataInterface::get_id);
|
| 749 | ||
| 750 | 4x |
Rcpp::class_<PopulationInterface>("Population")
|
| 751 | 2x |
.constructor() |
| 752 | 2x |
.method("get_id", &PopulationInterface::get_id, "get population ID")
|
| 753 | 2x |
.field("nages", &PopulationInterface::nages, "number of ages")
|
| 754 | 2x |
.field("nfleets", &PopulationInterface::nfleets, "number of fleets")
|
| 755 | 2x |
.field("nseasons", &PopulationInterface::nseasons, "number of seasons")
|
| 756 | 2x |
.field("nyears", &PopulationInterface::nyears, "number of years")
|
| 757 | 2x |
.field("nlengths", &PopulationInterface::nlengths, "number of lengths")
|
| 758 | 2x |
.field("log_M", &PopulationInterface::log_M, "natural log of the natural mortality of the population")
|
| 759 | 2x |
.field("log_init_naa", &PopulationInterface::log_init_naa, "natural log of the initial numbers at age")
|
| 760 | 2x |
.field("ages", &PopulationInterface::ages, "vector of ages in the population; length nages")
|
| 761 | 2x |
.method("evaluate", &PopulationInterface::evaluate, "evaluate the population function")
|
| 762 | 2x |
.method("SetMaturity", &PopulationInterface::SetMaturity, "Set the unique id for the Maturity object")
|
| 763 | 2x |
.method("SetGrowth", &PopulationInterface::SetGrowth, "Set the unique id for the growth object")
|
| 764 | 2x |
.method("SetRecruitment", &PopulationInterface::SetRecruitment, "Set the unique id for the Recruitment object")
|
| 765 | 2x |
.method("evaluate", &PopulationInterface::evaluate, "evaluate the population function");
|
| 766 | ||
| 767 | 4x |
Rcpp::class_<LogisticMaturityInterface>("LogisticMaturity")
|
| 768 | 2x |
.constructor() |
| 769 | 2x |
.field("inflection_point", &LogisticMaturityInterface::inflection_point)
|
| 770 | 2x |
.field("slope", &LogisticMaturityInterface::slope)
|
| 771 | 2x |
.method("get_id", &LogisticMaturityInterface::get_id)
|
| 772 | 2x |
.method("evaluate", &LogisticMaturityInterface::evaluate);
|
| 773 | ||
| 774 | 4x |
Rcpp::class_<LogisticSelectivityInterface>("LogisticSelectivity")
|
| 775 | 2x |
.constructor() |
| 776 | 2x |
.field("inflection_point",
|
| 777 |
&LogisticSelectivityInterface::inflection_point) |
|
| 778 | 2x |
.field("slope", &LogisticSelectivityInterface::slope)
|
| 779 | 2x |
.method("get_id", &LogisticSelectivityInterface::get_id)
|
| 780 | 2x |
.method("evaluate", &LogisticSelectivityInterface::evaluate);
|
| 781 | ||
| 782 | 4x |
Rcpp::class_<DoubleLogisticSelectivityInterface>("DoubleLogisticSelectivity")
|
| 783 | 2x |
.constructor() |
| 784 | 2x |
.field( |
| 785 |
"inflection_point_asc", |
|
| 786 |
&DoubleLogisticSelectivityInterface::inflection_point_asc, |
|
| 787 |
"50 percent quantile of the value of the quantity of interest (x) on the ascending limb of the double logistic curve; e.g., age at which 50 percent of the fish are selected.") |
|
| 788 | 2x |
.field( |
| 789 |
"slope_asc", |
|
| 790 |
&DoubleLogisticSelectivityInterface::slope_asc, |
|
| 791 |
"Scalar multiplier of difference between quantity of interest value (x) and inflection_point on the ascending limb of the double logistic curve.") |
|
| 792 | 2x |
.field( |
| 793 |
"inflection_point_desc", |
|
| 794 |
&DoubleLogisticSelectivityInterface::inflection_point_desc, |
|
| 795 |
"50 percent quantile of the value of the quantity of interest (x) on the descending limb of the double logistic curve; e.g. age at which 50 percent of the fish are selected.") |
|
| 796 | 2x |
.field( |
| 797 |
"slope_desc", |
|
| 798 |
&DoubleLogisticSelectivityInterface::slope_desc, |
|
| 799 |
"Scalar multiplier of difference between quantity of interest value (x) and inflection_point on the descending limb of the double logistic curve.") |
|
| 800 | 2x |
.method( |
| 801 |
"get_id", |
|
| 802 |
&DoubleLogisticSelectivityInterface::get_id, |
|
| 803 |
"Returns a unique ID for the selectivity class.") |
|
| 804 | 2x |
.method( |
| 805 |
"evaluate", |
|
| 806 |
&DoubleLogisticSelectivityInterface::evaluate, |
|
| 807 |
"Evaluates the double logistic selectivity given input value (e.g., age or size in selectivity)."); |
|
| 808 | ||
| 809 | 4x |
Rcpp::class_<EWAAGrowthInterface>("EWAAgrowth")
|
| 810 | 2x |
.constructor() |
| 811 | 2x |
.field("ages", &EWAAGrowthInterface::ages, "Ages for each age class.")
|
| 812 | 2x |
.field("weights", &EWAAGrowthInterface::weights, "Weights for each age class.")
|
| 813 | 2x |
.method("get_id", &EWAAGrowthInterface::get_id)
|
| 814 | 2x |
.method("evaluate", &EWAAGrowthInterface::evaluate);
|
| 815 | ||
| 816 | 4x |
Rcpp::class_<DnormDistributionsInterface>("DnormDistribution")
|
| 817 | 2x |
.constructor() |
| 818 | 2x |
.method("get_id", &DnormDistributionsInterface::get_id, "Returns a unique ID for the Dnorm distribution class.")
|
| 819 | 2x |
.method("evaluate", &DnormDistributionsInterface::evaluate, "Evaluates the normal distribution given input data and parameter values.")
|
| 820 | 2x |
.method("set_observed_data", &DnormDistributionsInterface::set_observed_data, "Accepts a unique ID for a given Data Object class to link the data with the distribution.")
|
| 821 | 2x |
.method("set_distribution_links", &DnormDistributionsInterface::set_distribution_links, "Accepts a unique ID for a given parameter to link the parameter with the distribution.")
|
| 822 | 2x |
.field("x", &DnormDistributionsInterface::x, "Input for distribution when not observations, e.g., prior or random effect.")
|
| 823 | 2x |
.field("expected_values", &DnormDistributionsInterface::expected_values, "Mean of the distribution.")
|
| 824 | 2x |
.field("log_sd", &DnormDistributionsInterface::log_sd, "The natural log of the standard deviation.");
|
| 825 | ||
| 826 | 4x |
Rcpp::class_<DlnormDistributionsInterface>("DlnormDistribution")
|
| 827 | 2x |
.constructor() |
| 828 | 2x |
.method("get_id", &DlnormDistributionsInterface::get_id, "Returns a unique ID for the Dnorm distribution class.")
|
| 829 | 2x |
.method("evaluate", &DlnormDistributionsInterface::evaluate, "Evaluates the normal distribution given input data and parameter values.")
|
| 830 | 2x |
.method("set_observed_data", &DlnormDistributionsInterface::set_observed_data, "Accepts a unique ID for a given Data Object class to link the data with the distribution.")
|
| 831 | 2x |
.method("set_distribution_links", &DlnormDistributionsInterface::set_distribution_links, "Accepts a unique ID for a given parameter to link the parameter with the distribution.")
|
| 832 | 2x |
.field("x", &DlnormDistributionsInterface::x, "Input for distribution when not observations, e.g., prior or random effect.")
|
| 833 | 2x |
.field("expected_values", &DlnormDistributionsInterface::expected_values, "Mean of the distribution on the natural log scale.")
|
| 834 | 2x |
.field("log_sd", &DlnormDistributionsInterface::log_sd, "The natural log of the standard deviation of the distribution on the natural log scale.");
|
| 835 | ||
| 836 | 4x |
Rcpp::class_<DmultinomDistributionsInterface>("DmultinomDistribution")
|
| 837 | 2x |
.constructor() |
| 838 | 2x |
.method("get_id", &DmultinomDistributionsInterface::get_id, "Returns a unique ID for the Dnorm distribution class.")
|
| 839 | 2x |
.method("evaluate", &DmultinomDistributionsInterface::evaluate, "Evaluates the normal distribution given input data and parameter values.")
|
| 840 | 2x |
.method("set_observed_data", &DmultinomDistributionsInterface::set_observed_data, "Accepts a unique ID for a given Data Object class to link the data with the distribution.")
|
| 841 | 2x |
.method("set_distribution_links", &DmultinomDistributionsInterface::set_distribution_links, "Accepts a unique ID for a given parameter to link the parameter with the distribution.")
|
| 842 | 2x |
.field("x", &DmultinomDistributionsInterface::x, "Input for distribution when not observations, e.g., prior or random effect.")
|
| 843 | 2x |
.field("expected_values", &DmultinomDistributionsInterface::expected_values, "numeric non-negative vector of length K, specifying the probability for the K classes.")
|
| 844 | 2x |
.field("dims", &DmultinomDistributionsInterface::dims, "dimension of the multivariate input, e.g., c(num rows, num cols).");
|
| 845 |
} |
|
| 846 | ||
| 847 |
#endif /* RCPP_INTERFACE_HPP */ |
| 1 |
/** |
|
| 2 |
* @file rcpp_fleet.hpp |
|
| 3 |
* @brief The Rcpp interface to declare different types of data, e.g., |
|
| 4 |
* age-composition and index data. Allows for the use of methods::new() in R. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_DATA_HPP |
|
| 10 |
#define FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_DATA_HPP |
|
| 11 | ||
| 12 |
#include "../../../common/information.hpp" |
|
| 13 |
#include "rcpp_interface_base.hpp" |
|
| 14 | ||
| 15 |
/** |
|
| 16 |
* @brief Rcpp interface that serves as the parent class for Rcpp data |
|
| 17 |
* interfaces. This type should be inherited and not called from R directly. |
|
| 18 |
*/ |
|
| 19 |
class DataInterfaceBase : public FIMSRcppInterfaceBase {
|
|
| 20 |
public: |
|
| 21 |
/** |
|
| 22 |
* @brief The vector of data that is being passed from R. |
|
| 23 |
*/ |
|
| 24 |
Rcpp::NumericVector observed_data; |
|
| 25 |
/** |
|
| 26 |
* @brief The static id of the DataInterfaceBase object. |
|
| 27 |
*/ |
|
| 28 |
static uint32_t id_g; |
|
| 29 |
/** |
|
| 30 |
* @brief The local id of the DataInterfaceBase object. |
|
| 31 |
* |
|
| 32 |
*/ |
|
| 33 |
uint32_t id; |
|
| 34 |
/** |
|
| 35 |
* @brief The map associating the IDs of DataInterfaceBase to the objects. |
|
| 36 |
* This is a live object, which is an object that has been created and lives |
|
| 37 |
* in memory. |
|
| 38 |
*/ |
|
| 39 |
static std::map<uint32_t, DataInterfaceBase*> live_objects; |
|
| 40 | ||
| 41 |
/** |
|
| 42 |
* @brief The constructor. |
|
| 43 |
*/ |
|
| 44 | ! |
DataInterfaceBase() {
|
| 45 | ! |
this->id = DataInterfaceBase::id_g++; |
| 46 |
/* Create instance of map: key is id and value is pointer to |
|
| 47 |
DataInterfaceBase */ |
|
| 48 | ! |
DataInterfaceBase::live_objects[this->id] = this; |
| 49 | ! |
FIMSRcppInterfaceBase::fims_interface_objects.push_back(this); |
| 50 |
} |
|
| 51 | ||
| 52 |
/** |
|
| 53 |
* @brief The destructor. |
|
| 54 |
*/ |
|
| 55 | ! |
virtual ~DataInterfaceBase() {}
|
| 56 | ||
| 57 |
/** |
|
| 58 |
* @brief Get the ID for the child data interface objects to inherit. |
|
| 59 |
*/ |
|
| 60 | ! |
virtual uint32_t get_id() { return this->id; }
|
| 61 | ||
| 62 |
/** |
|
| 63 |
* @brief Adds the parameters to the TMB model. |
|
| 64 |
*/ |
|
| 65 | ! |
virtual bool add_to_fims_tmb() { return true; };
|
| 66 |
}; |
|
| 67 |
// static id of the DataInterfaceBase object |
|
| 68 |
uint32_t DataInterfaceBase::id_g = 1; |
|
| 69 |
// local id of the DataInterfaceBase object map relating the ID of the |
|
| 70 |
// DataInterfaceBase to the DataInterfaceBase objects |
|
| 71 |
std::map<uint32_t, DataInterfaceBase*> DataInterfaceBase::live_objects; |
|
| 72 | ||
| 73 |
/** |
|
| 74 |
* @brief The Rcpp interface for AgeComp to instantiate the object from R: |
|
| 75 |
* acomp <- methods::new(AgeComp). |
|
| 76 |
*/ |
|
| 77 |
class AgeCompDataInterface : public DataInterfaceBase {
|
|
| 78 |
public: |
|
| 79 |
/** |
|
| 80 |
* @brief The first dimension of the data, which relates to the number of age |
|
| 81 |
* bins. |
|
| 82 |
*/ |
|
| 83 |
int amax; |
|
| 84 |
/** |
|
| 85 |
* @brief The second dimension of the data, which relates to the number of |
|
| 86 |
* time steps or years. |
|
| 87 |
*/ |
|
| 88 |
int ymax; |
|
| 89 |
/** |
|
| 90 |
* @brief The vector of age-composition data that is being passed from R. |
|
| 91 |
*/ |
|
| 92 |
Rcpp::NumericVector age_comp_data; |
|
| 93 | ||
| 94 |
/** |
|
| 95 |
* @brief The constructor. |
|
| 96 |
*/ |
|
| 97 | ! |
AgeCompDataInterface(int ymax = 0, int amax = 0) : DataInterfaceBase() {
|
| 98 | ! |
this->amax = amax; |
| 99 | ! |
this->ymax = ymax; |
| 100 |
} |
|
| 101 | ||
| 102 |
/** |
|
| 103 |
* @brief The destructor. |
|
| 104 |
*/ |
|
| 105 | ! |
virtual ~AgeCompDataInterface() {}
|
| 106 | ||
| 107 |
/** |
|
| 108 |
* @brief Gets the ID of the interface base object. |
|
| 109 |
* @return The ID. |
|
| 110 |
*/ |
|
| 111 | ! |
virtual uint32_t get_id() { return this->id; }
|
| 112 |
|
|
| 113 |
/** |
|
| 114 |
* @brief Converts the data to json representation for the output. |
|
| 115 |
* @return A string is returned specifying that the module relates to the |
|
| 116 |
* data interface with age-composition data. It also returns the ID, the rank |
|
| 117 |
* of 2, the dimensions by printing ymax and amax, followed by the data values |
|
| 118 |
* themselves. This string is formatted for a json file. |
|
| 119 |
*/ |
|
| 120 | ! |
virtual std::string to_json() {
|
| 121 | ! |
std::stringstream ss; |
| 122 |
|
|
| 123 | ! |
ss << "\"module\" : {\n";
|
| 124 | ! |
ss << " \"name\": \"data\",\n"; |
| 125 | ! |
ss << " \"type\" : \"AgeComp\",\n"; |
| 126 | ! |
ss << " \"id\":" << this->id << ",\n"; |
| 127 | ! |
ss << " \"rank\": " << 2 << ",\n"; |
| 128 | ! |
ss << " \"dimensions\": [" << this->ymax << "," << this->amax << "],\n"; |
| 129 | ! |
ss << " \"values\": ["; |
| 130 | ! |
for (R_xlen_t i = 0; i < age_comp_data.size() - 1; i++) {
|
| 131 | ! |
ss << age_comp_data[i] << ", "; |
| 132 |
} |
|
| 133 | ! |
ss << age_comp_data[age_comp_data.size() - 1] << "]\n"; |
| 134 | ! |
ss << "}"; |
| 135 | ! |
return ss.str(); |
| 136 |
} |
|
| 137 |
|
|
| 138 | ||
| 139 |
#ifdef TMB_MODEL |
|
| 140 | ||
| 141 |
template <typename Type> |
|
| 142 | ! |
bool add_to_fims_tmb_internal() {
|
| 143 |
std::shared_ptr<fims_data_object::DataObject<Type>> age_comp_data = |
|
| 144 | ! |
std::make_shared<fims_data_object::DataObject<Type>>(this->ymax, |
| 145 | ! |
this->amax); |
| 146 | ||
| 147 | ! |
age_comp_data->id = this->id; |
| 148 | ! |
for (int y = 0; y < ymax; y++) {
|
| 149 | ! |
for (int a = 0; a < amax; a++) {
|
| 150 | ! |
int i_age_year = y * amax + a; |
| 151 | ! |
age_comp_data->at(y, a) = this->age_comp_data[i_age_year]; |
| 152 |
} |
|
| 153 |
} |
|
| 154 | ||
| 155 |
std::shared_ptr<fims_info::Information<Type>> info = |
|
| 156 | ! |
fims_info::Information<Type>::GetInstance(); |
| 157 | ||
| 158 | ! |
info->data_objects[this->id] = age_comp_data; |
| 159 | ||
| 160 |
return true; |
|
| 161 |
} |
|
| 162 | ||
| 163 |
/** |
|
| 164 |
* @brief Adds the parameters to the TMB model. |
|
| 165 |
* @return A boolean of true. |
|
| 166 |
*/ |
|
| 167 | ! |
virtual bool add_to_fims_tmb() {
|
| 168 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 169 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 170 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 171 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 172 | ||
| 173 | ! |
return true; |
| 174 |
} |
|
| 175 | ||
| 176 |
#endif |
|
| 177 |
}; |
|
| 178 | ||
| 179 |
/** |
|
| 180 |
* @brief The Rcpp interface for LengthComp to instantiate the object from R: |
|
| 181 |
* lcomp <- methods::new(LengthComp). |
|
| 182 |
*/ |
|
| 183 |
class LengthCompDataInterface : public DataInterfaceBase {
|
|
| 184 |
public: |
|
| 185 |
/** |
|
| 186 |
* @brief The first dimension of the data, which relates to the number of |
|
| 187 |
* length bins. |
|
| 188 |
*/ |
|
| 189 |
int lmax; |
|
| 190 |
/** |
|
| 191 |
* @brief The second dimension of the data, which relates to the number of |
|
| 192 |
* time steps or years. |
|
| 193 |
*/ |
|
| 194 |
int ymax; |
|
| 195 |
/** |
|
| 196 |
* @brief The vector of length-composition data that is being passed from R. |
|
| 197 |
*/ |
|
| 198 |
Rcpp::NumericVector length_comp_data; |
|
| 199 | ||
| 200 |
/** |
|
| 201 |
* @brief The constructor. |
|
| 202 |
*/ |
|
| 203 | ! |
LengthCompDataInterface(int ymax = 0, int lmax = 0) : DataInterfaceBase() {
|
| 204 | ! |
this->lmax = lmax; |
| 205 | ! |
this->ymax = ymax; |
| 206 |
} |
|
| 207 | ||
| 208 |
/** |
|
| 209 |
* @brief The destructor. |
|
| 210 |
*/ |
|
| 211 | ! |
virtual ~LengthCompDataInterface() {}
|
| 212 | ||
| 213 |
/** |
|
| 214 |
* @brief Gets the ID of the interface base object. |
|
| 215 |
* @return The ID. |
|
| 216 |
*/ |
|
| 217 | ! |
virtual uint32_t get_id() { return this->id; }
|
| 218 |
|
|
| 219 |
/** |
|
| 220 |
* @brief Converts the data to json representation for the output. |
|
| 221 |
* @return A string is returned specifying that the module relates to the |
|
| 222 |
* data interface with length-composition data. It also returns the ID, the |
|
| 223 |
* rank of 2, the dimensions by printing ymax and lmax, followed by the data |
|
| 224 |
* values themselves. This string is formatted for a json file. |
|
| 225 |
*/ |
|
| 226 | ! |
virtual std::string to_json() {
|
| 227 | ! |
std::stringstream ss; |
| 228 |
|
|
| 229 | ! |
ss << "\"module\" : {\n";
|
| 230 | ! |
ss << " \"name\": \"data\",\n"; |
| 231 | ! |
ss << " \"type\" : \"LengthComp\",\n"; |
| 232 | ! |
ss << " \"id\":" << this->id << ",\n"; |
| 233 | ! |
ss << " \"rank\": " << 2 << ",\n"; |
| 234 | ! |
ss << " \"dimensions\": [" << this->ymax << "," << this->lmax << "],\n"; |
| 235 | ! |
ss << " \"values\": ["; |
| 236 | ! |
for (R_xlen_t i = 0; i < length_comp_data.size() - 1; i++) {
|
| 237 | ! |
ss << length_comp_data[i] << ", "; |
| 238 |
} |
|
| 239 | ! |
ss << length_comp_data[length_comp_data.size() - 1] << "]\n"; |
| 240 | ! |
ss << "}"; |
| 241 | ! |
return ss.str(); |
| 242 |
} |
|
| 243 |
|
|
| 244 |
#ifdef TMB_MODEL |
|
| 245 |
template <typename Type> |
|
| 246 | ! |
bool add_to_fims_tmb_internal() {
|
| 247 |
std::shared_ptr<fims_data_object::DataObject<Type>> length_comp_data = |
|
| 248 | ! |
std::make_shared<fims_data_object::DataObject<Type>>(this->ymax, |
| 249 | ! |
this->lmax); |
| 250 | ! |
length_comp_data->id = this->id; |
| 251 | ! |
for (int y = 0; y < ymax; y++) {
|
| 252 | ! |
for (int l = 0; l < lmax; l++) {
|
| 253 | ! |
int i_length_year = y * lmax + l; |
| 254 | ! |
length_comp_data->at(y, l) = this->length_comp_data[i_length_year]; |
| 255 |
} |
|
| 256 |
} |
|
| 257 |
std::shared_ptr<fims_info::Information<Type>> info = |
|
| 258 | ! |
fims_info::Information<Type>::GetInstance(); |
| 259 | ! |
info->data_objects[this->id] = length_comp_data; |
| 260 |
return true; |
|
| 261 |
} |
|
| 262 | ||
| 263 |
/** |
|
| 264 |
* @brief Adds the parameters to the TMB model. |
|
| 265 |
* @return A boolean of true. |
|
| 266 |
*/ |
|
| 267 | ! |
virtual bool add_to_fims_tmb() {
|
| 268 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 269 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 270 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 271 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 272 | ! |
return true; |
| 273 |
} |
|
| 274 |
#endif |
|
| 275 |
}; |
|
| 276 | ||
| 277 |
/** |
|
| 278 |
* @brief The Rcpp interface for Index to instantiate the object from R: |
|
| 279 |
* fleet <- methods::new(Index). |
|
| 280 |
*/ |
|
| 281 |
class IndexDataInterface : public DataInterfaceBase {
|
|
| 282 |
public: |
|
| 283 |
/** |
|
| 284 |
* @brief An integer that specifies the second dimension of the data. |
|
| 285 |
*/ |
|
| 286 |
int ymax; |
|
| 287 |
/** |
|
| 288 |
* @brief The vector of index data that is being passed from R. |
|
| 289 |
*/ |
|
| 290 |
Rcpp::NumericVector index_data; |
|
| 291 | ||
| 292 |
/** |
|
| 293 |
* @brief The constructor. |
|
| 294 |
*/ |
|
| 295 | ! |
IndexDataInterface(int ymax = 0) : DataInterfaceBase() { this->ymax = ymax; }
|
| 296 | ||
| 297 |
/** |
|
| 298 |
* @brief The destructor. |
|
| 299 |
*/ |
|
| 300 | ! |
virtual ~IndexDataInterface() {}
|
| 301 | ||
| 302 |
/** |
|
| 303 |
* @brief Gets the ID of the interface base object. |
|
| 304 |
* @return The ID. |
|
| 305 |
*/ |
|
| 306 | ! |
virtual uint32_t get_id() { return this->id; }
|
| 307 |
|
|
| 308 |
/** |
|
| 309 |
* @brief Converts the data to json representation for the output. |
|
| 310 |
* @return A string is returned specifying that the module relates to the |
|
| 311 |
* data interface with index data. It also returns the ID, the rank of 1, the |
|
| 312 |
* dimensions by printing ymax, followed by the data values themselves. This |
|
| 313 |
* string is formatted for a json file. |
|
| 314 |
*/ |
|
| 315 | ! |
virtual std::string to_json() {
|
| 316 | ! |
std::stringstream ss; |
| 317 |
|
|
| 318 | ! |
ss << "\"module\" : {\n";
|
| 319 | ! |
ss << " \"name\": \"data\",\n"; |
| 320 | ! |
ss << " \"type\": \"Index\",\n"; |
| 321 | ! |
ss << " \"id\": " << this->id << ",\n"; |
| 322 | ! |
ss << " \"rank\": " << 1 << ",\n"; |
| 323 | ! |
ss << " \"dimensions\": [" << this->ymax << "],\n"; |
| 324 | ! |
ss << " \"values\": ["; |
| 325 | ! |
for (R_xlen_t i = 0; i < index_data.size() - 1; i++) {
|
| 326 | ! |
ss << index_data[i] << ", "; |
| 327 |
} |
|
| 328 | ! |
ss << index_data[index_data.size() - 1] << "]\n"; |
| 329 | ! |
ss << "}"; |
| 330 | ! |
return ss.str(); |
| 331 |
} |
|
| 332 | ||
| 333 |
#ifdef TMB_MODEL |
|
| 334 | ||
| 335 |
template <typename Type> |
|
| 336 | ! |
bool add_to_fims_tmb_internal() {
|
| 337 |
std::shared_ptr<fims_data_object::DataObject<Type>> data = |
|
| 338 | ! |
std::make_shared<fims_data_object::DataObject<Type>>(this->ymax); |
| 339 | ||
| 340 | ! |
data->id = this->id; |
| 341 | ||
| 342 | ! |
for (int y = 0; y < ymax; y++) {
|
| 343 | ! |
data->at(y) = this->index_data[y]; |
| 344 |
} |
|
| 345 | ||
| 346 |
std::shared_ptr<fims_info::Information<Type>> info = |
|
| 347 | ! |
fims_info::Information<Type>::GetInstance(); |
| 348 | ||
| 349 | ! |
info->data_objects[this->id] = data; |
| 350 |
return true; |
|
| 351 |
} |
|
| 352 | ||
| 353 |
/** |
|
| 354 |
* @brief Adds the parameters to the TMB model. |
|
| 355 |
* @return A boolean of true. |
|
| 356 |
*/ |
|
| 357 | ! |
virtual bool add_to_fims_tmb() {
|
| 358 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 359 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 360 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 361 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 362 | ||
| 363 | ! |
return true; |
| 364 |
} |
|
| 365 | ||
| 366 |
#endif |
|
| 367 |
}; |
|
| 368 | ||
| 369 |
#endif |
| 1 |
/** |
|
| 2 |
* @file rcpp_distribution.hpp |
|
| 3 |
* @brief The Rcpp interface to declare different distributions, e.g., |
|
| 4 |
* normal and log normal. Allows for the use of methods::new() in R. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_DISTRIBUTION_HPP |
|
| 10 |
#define FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_DISTRIBUTION_HPP |
|
| 11 | ||
| 12 |
#include "../../../distributions/distributions.hpp" |
|
| 13 |
#include "../../interface.hpp" |
|
| 14 |
#include "rcpp_interface_base.hpp" |
|
| 15 | ||
| 16 |
/** |
|
| 17 |
* @brief Rcpp interface that serves as the parent class for Rcpp distribution |
|
| 18 |
* interfaces. This type should be inherited and not called from R directly. |
|
| 19 |
*/ |
|
| 20 |
class DistributionsInterfaceBase : public FIMSRcppInterfaceBase {
|
|
| 21 |
public: |
|
| 22 |
/** |
|
| 23 |
* @brief The static ID of the DistributionsInterfaceBase object. |
|
| 24 |
*/ |
|
| 25 |
static uint32_t id_g; |
|
| 26 |
/** |
|
| 27 |
* @brief The local ID of the DistributionsInterfaceBase object. |
|
| 28 |
*/ |
|
| 29 |
uint32_t id_m; |
|
| 30 |
/** |
|
| 31 |
* @brief The unique ID for the variable map that points to a fims::Vector. |
|
| 32 |
*/ |
|
| 33 |
std::vector<uint32_t> key_m; |
|
| 34 |
/** |
|
| 35 |
* @brief The type of density input. The options are prior, re, or data. |
|
| 36 |
*/ |
|
| 37 |
std::string input_type_m; |
|
| 38 |
/** |
|
| 39 |
* @brief The map associating the ID of the DistributionsInterfaceBase to the |
|
| 40 |
DistributionsInterfaceBase objects. This is a live object, which is an |
|
| 41 |
object that has been created and lives in memory. |
|
| 42 |
*/ |
|
| 43 |
static std::map<uint32_t, DistributionsInterfaceBase *> live_objects; |
|
| 44 |
/** |
|
| 45 |
* @brief The ID of the observed data object, which is set to -999. |
|
| 46 |
*/ |
|
| 47 | ! |
uint32_t interface_observed_data_id_m = -999; |
| 48 | ||
| 49 |
/** |
|
| 50 |
* @brief The constructor. |
|
| 51 |
*/ |
|
| 52 | ! |
DistributionsInterfaceBase() {
|
| 53 | ! |
this->id_m = DistributionsInterfaceBase::id_g++; |
| 54 |
/* Create instance of map: key is id and value is pointer to |
|
| 55 |
DistributionsInterfaceBase */ |
|
| 56 | ! |
DistributionsInterfaceBase::live_objects[this->id_m] = this; |
| 57 | ! |
FIMSRcppInterfaceBase::fims_interface_objects.push_back(this); |
| 58 |
} |
|
| 59 | ||
| 60 |
/** |
|
| 61 |
* @brief The destructor. |
|
| 62 |
*/ |
|
| 63 | ! |
virtual ~DistributionsInterfaceBase() {}
|
| 64 | ||
| 65 |
/** |
|
| 66 |
* @brief Get the ID for the child distribution interface objects to inherit. |
|
| 67 |
*/ |
|
| 68 |
virtual uint32_t get_id() = 0; |
|
| 69 | ||
| 70 |
/** |
|
| 71 |
* @brief Sets pointers for data observations, random effects, or priors. |
|
| 72 |
* |
|
| 73 |
* @param input_type String that sets whether the distribution type is for priors, random effects, or data. |
|
| 74 |
* @param ids Vector of unique ids for each linked parameter(s), derived |
|
| 75 |
* value(s), or observed data vector. |
|
| 76 |
*/ |
|
| 77 | ! |
virtual bool set_distribution_links(std::string input_type, Rcpp::IntegerVector ids){
|
| 78 | ! |
return false; |
| 79 |
} |
|
| 80 | ||
| 81 |
/** |
|
| 82 |
* @brief Set the unique ID for the observed data object. |
|
| 83 |
* |
|
| 84 |
* @param observed_data_id Unique ID for the Observed Age Comp Data |
|
| 85 |
* object |
|
| 86 |
*/ |
|
| 87 | ! |
virtual bool set_observed_data(int observed_data_id){
|
| 88 | ! |
return false; |
| 89 |
} |
|
| 90 | ||
| 91 |
/** |
|
| 92 |
* @brief A method for each child distribution interface object to inherit so |
|
| 93 |
* each distribution can have an evaluate() function. |
|
| 94 |
*/ |
|
| 95 |
virtual double evaluate() = 0; |
|
| 96 |
}; |
|
| 97 |
// static id of the DistributionsInterfaceBase object |
|
| 98 |
uint32_t DistributionsInterfaceBase::id_g = 1; |
|
| 99 |
// local id of the DistributionsInterfaceBase object map relating the ID of the |
|
| 100 |
// DistributionsInterfaceBase to the DistributionsInterfaceBase objects |
|
| 101 |
std::map<uint32_t, |
|
| 102 |
DistributionsInterfaceBase*> DistributionsInterfaceBase::live_objects; |
|
| 103 | ||
| 104 |
/** |
|
| 105 |
* @brief The Rcpp interface for Dnorm to instantiate from R: |
|
| 106 |
* dnorm_ <- methods::new(DnormDistribution). |
|
| 107 |
*/ |
|
| 108 |
class DnormDistributionsInterface : public DistributionsInterfaceBase {
|
|
| 109 |
public: |
|
| 110 |
/** |
|
| 111 |
* @brief Observed data. |
|
| 112 |
*/ |
|
| 113 |
ParameterVector x; |
|
| 114 |
/** |
|
| 115 |
* @brief The expected values, which would be the mean of x for this |
|
| 116 |
* distribution. |
|
| 117 |
*/ |
|
| 118 |
ParameterVector expected_values; |
|
| 119 |
/** |
|
| 120 |
* @brief The uncertainty, which would be the standard deviation of x for the |
|
| 121 |
* normal distribution. |
|
| 122 |
*/ |
|
| 123 |
ParameterVector log_sd; |
|
| 124 |
/** |
|
| 125 |
* @brief The vector. TODO: document this more. |
|
| 126 |
*/ |
|
| 127 |
Rcpp::NumericVector lpdf_vec; /**< The vector*/ |
|
| 128 | ||
| 129 |
/** |
|
| 130 |
* @brief The constructor. |
|
| 131 |
*/ |
|
| 132 | ! |
DnormDistributionsInterface() : DistributionsInterfaceBase() {}
|
| 133 | ||
| 134 |
/** |
|
| 135 |
* @brief The destructor. |
|
| 136 |
*/ |
|
| 137 | ! |
virtual ~DnormDistributionsInterface() {}
|
| 138 | ||
| 139 |
/** |
|
| 140 |
* @brief Gets the ID of the interface base object. |
|
| 141 |
* @return The ID. |
|
| 142 |
*/ |
|
| 143 | ! |
virtual uint32_t get_id() { return this->id_m; }
|
| 144 | ||
| 145 |
/** |
|
| 146 |
* @brief Set the unique ID for the observed data object. |
|
| 147 |
* @param observed_data_id Unique ID for the observed data object. |
|
| 148 |
*/ |
|
| 149 | ! |
virtual bool set_observed_data(int observed_data_id) {
|
| 150 | ! |
this->interface_observed_data_id_m = observed_data_id; |
| 151 | ! |
return true; |
| 152 |
} |
|
| 153 | ||
| 154 |
/** |
|
| 155 |
* @brief Sets pointers for data observations, random effects, or priors. |
|
| 156 |
* |
|
| 157 |
* @param input_type String that sets whether the distribution type is for priors, random effects, or data. |
|
| 158 |
* @param ids Vector of unique ids for each linked parameter(s), derived |
|
| 159 |
* value(s), or observed data vector. |
|
| 160 |
*/ |
|
| 161 | ! |
virtual bool set_distribution_links(std::string input_type, Rcpp::IntegerVector ids){
|
| 162 | ! |
this->input_type_m = input_type; |
| 163 | ! |
this->key_m.resize(ids.size()); |
| 164 | ! |
for(int i=0; i<ids.size(); i++){
|
| 165 | ! |
this->key_m[i] = ids[i]; |
| 166 |
} |
|
| 167 | ! |
return true; |
| 168 |
} |
|
| 169 | ||
| 170 |
/** |
|
| 171 |
* @brief Evaluate normal probability density function (pdf). The natural log |
|
| 172 |
* of the pdf is returned. |
|
| 173 |
* @return The natural log of the probability density function (pdf) is |
|
| 174 |
* returned. |
|
| 175 |
*/ |
|
| 176 | ! |
virtual double evaluate() {
|
| 177 | ! |
fims_distributions::NormalLPDF<double> dnorm; |
| 178 | ! |
dnorm.x.resize(this->x.size()); |
| 179 | ! |
dnorm.expected_values.resize(this->expected_values.size()); |
| 180 | ! |
dnorm.log_sd.resize(this->log_sd.size()); |
| 181 | ! |
for(size_t i=0; i<x.size(); i++){
|
| 182 | ! |
dnorm.x[i] = this->x[i].initial_value_m; |
| 183 |
} |
|
| 184 | ! |
for(size_t i=0; i<expected_values.size(); i++){
|
| 185 | ! |
dnorm.expected_values[i] = this->expected_values[i].initial_value_m; |
| 186 |
} |
|
| 187 | ! |
for(size_t i=0; i<log_sd.size(); i++){
|
| 188 | ! |
dnorm.log_sd[i] = this->log_sd[i].initial_value_m; |
| 189 |
} |
|
| 190 | ! |
return dnorm.evaluate(); |
| 191 |
} |
|
| 192 | ||
| 193 |
/** |
|
| 194 |
* @brief Extracts the derived quantities from `Information` to the Rcpp |
|
| 195 |
* object. |
|
| 196 |
*/ |
|
| 197 | ! |
virtual void finalize() {
|
| 198 | ! |
if (this->finalized) {
|
| 199 |
//log warning that finalize has been called more than once. |
|
| 200 | ! |
FIMS_WARNING_LOG("DnormDistribution " + fims::to_string(this->id_m) + " has been finalized already.");
|
| 201 |
} |
|
| 202 | ||
| 203 | ! |
this->finalized = true; //indicate this has been called already |
| 204 | ||
| 205 |
std::shared_ptr<fims_info::Information<double> > info = |
|
| 206 | ! |
fims_info::Information<double>::GetInstance(); |
| 207 | ||
| 208 | ! |
fims_info::Information<double>::density_components_iterator it; |
| 209 | ||
| 210 |
//search for density component in Information |
|
| 211 | ! |
it = info->density_components.find(this->id_m); |
| 212 |
//if not found, just return |
|
| 213 | ! |
if (it == info->density_components.end()) {
|
| 214 | ! |
FIMS_WARNING_LOG("DnormDistribution " + fims::to_string(this->id_m) + " not found in Information.");
|
| 215 | ! |
return; |
| 216 |
} else {
|
|
| 217 |
std::shared_ptr<fims_distributions::NormalLPDF<double> > dnorm = |
|
| 218 | ! |
std::dynamic_pointer_cast<fims_distributions::NormalLPDF<double> >(it->second); |
| 219 | ! |
this->lpdf_vec = Rcpp::NumericVector(dnorm->lpdf_vec.size()); |
| 220 | ! |
for(R_xlen_t i=0; i < this->lpdf_vec.size(); i++) {
|
| 221 | ! |
this->lpdf_vec[i] = dnorm->lpdf_vec[i]; |
| 222 |
} |
|
| 223 |
} |
|
| 224 |
} |
|
| 225 | ||
| 226 |
/** |
|
| 227 |
* @brief Converts the data to json representation for the output. |
|
| 228 |
* @return A string is returned specifying that the module relates to the |
|
| 229 |
* distribution interface with a normal distribution. It also returns the ID |
|
| 230 |
* and the natural log of the probability density function values themselves. |
|
| 231 |
* This string is formatted for a json file. |
|
| 232 |
*/ |
|
| 233 | ! |
virtual std::string to_json() {
|
| 234 | ! |
std::stringstream ss; |
| 235 | ||
| 236 | ! |
ss << "\"module\" : {\n";
|
| 237 | ! |
ss << " \"name\": \"DnormDistribution\",\n"; |
| 238 | ! |
ss << " \"type\": \"normal\",\n"; |
| 239 | ! |
ss << " \"id\": " << this->id_m << ",\n"; |
| 240 | ||
| 241 | ! |
ss << " \"density_component\": {\n";
|
| 242 | ! |
ss << " \"name\": \"lpdf_vec\",\n"; |
| 243 | ! |
ss << " \"values\":["; |
| 244 | ! |
if (this->lpdf_vec.size() == 0) {
|
| 245 | ! |
ss << "]\n"; |
| 246 |
} else {
|
|
| 247 | ! |
for(R_xlen_t i=0; i < this->lpdf_vec.size() - 1; i++) {
|
| 248 | ! |
ss << this->lpdf_vec[i] << ", "; |
| 249 |
} |
|
| 250 | ! |
ss << this->lpdf_vec[this->lpdf_vec.size() - 1] << "]\n"; |
| 251 |
} |
|
| 252 | ! |
ss << " }\n]"; |
| 253 | ||
| 254 | ! |
return ss.str(); |
| 255 |
} |
|
| 256 | ||
| 257 | ||
| 258 |
#ifdef TMB_MODEL |
|
| 259 | ||
| 260 |
template <typename Type> |
|
| 261 | ! |
bool add_to_fims_tmb_internal() {
|
| 262 |
std::shared_ptr<fims_info::Information<Type>> info = |
|
| 263 | ! |
fims_info::Information<Type>::GetInstance(); |
| 264 | ||
| 265 |
std::shared_ptr<fims_distributions::NormalLPDF<Type>> distribution = |
|
| 266 | ! |
std::make_shared<fims_distributions::NormalLPDF<Type>>(); |
| 267 | ||
| 268 |
// interface to data/parameter value |
|
| 269 | ||
| 270 | ! |
distribution->observed_data_id_m = |
| 271 | ! |
interface_observed_data_id_m; |
| 272 | ! |
distribution->input_type = this->input_type_m; |
| 273 | ! |
distribution->key.resize(this->key_m.size()); |
| 274 | ! |
for(size_t i=0; i<this->key_m.size(); i++){
|
| 275 | ! |
distribution->key[i] = this->key_m[i]; |
| 276 |
} |
|
| 277 | ! |
distribution->id = this->id_m; |
| 278 | ! |
distribution->x.resize(this->x.size()); |
| 279 | ! |
for(size_t i=0; i<this->x.size(); i++){
|
| 280 | ! |
distribution->x[i] = this->x[i].initial_value_m; |
| 281 |
} |
|
| 282 |
// set relative info |
|
| 283 | ! |
distribution->expected_values.resize(this->expected_values.size()); |
| 284 | ! |
for(size_t i=0; i<this->expected_values.size(); i++) {
|
| 285 | ! |
distribution->expected_values[i] = this->expected_values[i].initial_value_m; |
| 286 |
} |
|
| 287 | ! |
distribution->log_sd.resize(this->log_sd.size()); |
| 288 | ! |
for(size_t i=0; i<this->log_sd.size(); i++){
|
| 289 | ! |
distribution->log_sd[i] = this->log_sd[i].initial_value_m; |
| 290 | ! |
if(this->log_sd[i].estimated_m){
|
| 291 | ! |
info->RegisterParameterName("normal log_sd");
|
| 292 | ! |
info->RegisterParameter(distribution->log_sd[i]); |
| 293 |
} |
|
| 294 | ! |
if (this->log_sd[i].is_random_effect_m) {
|
| 295 | ! |
error("standard deviations cannot be set to random effects");
|
| 296 |
} |
|
| 297 |
} |
|
| 298 | ! |
info->variable_map[this->log_sd.id_m] = &(distribution)->log_sd; |
| 299 | ||
| 300 | ! |
info->density_components[distribution->id] = distribution; |
| 301 | ||
| 302 |
return true; |
|
| 303 |
} |
|
| 304 | ||
| 305 |
/** |
|
| 306 |
* @brief Adds the parameters to the TMB model. |
|
| 307 |
* @return A boolean of true. |
|
| 308 |
*/ |
|
| 309 | ! |
virtual bool add_to_fims_tmb() {
|
| 310 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 311 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 312 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 313 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 314 | ||
| 315 | ! |
return true; |
| 316 |
} |
|
| 317 | ||
| 318 |
#endif |
|
| 319 |
}; |
|
| 320 | ||
| 321 |
/** |
|
| 322 |
* @brief The Rcpp interface for Dlnorm to instantiate from R: |
|
| 323 |
* dlnorm_ <- methods::new(DlnormDistribution). |
|
| 324 |
*/ |
|
| 325 |
class DlnormDistributionsInterface : public DistributionsInterfaceBase {
|
|
| 326 |
public: |
|
| 327 |
/** |
|
| 328 |
* @brief Observed data. |
|
| 329 |
*/ |
|
| 330 |
ParameterVector x; |
|
| 331 |
/** |
|
| 332 |
* @brief The expected values, which would be the mean of log(x) for this |
|
| 333 |
* distribution. |
|
| 334 |
*/ |
|
| 335 |
ParameterVector expected_values; |
|
| 336 |
/** |
|
| 337 |
* @brief The uncertainty, which would be the natural logarithm of the |
|
| 338 |
standard deviation (sd) of log(x) for this distribution. The natural log |
|
| 339 |
of the standard deviation is necessary because the exponential link |
|
| 340 |
function is applied to the log transformed standard deviation to insure |
|
| 341 |
standard deviation is positive. |
|
| 342 |
*/ |
|
| 343 |
ParameterVector log_sd; |
|
| 344 |
/** |
|
| 345 |
* @brief The vector. TODO: document this more. |
|
| 346 |
*/ |
|
| 347 |
Rcpp::NumericVector lpdf_vec; /**< The vector */ |
|
| 348 | ||
| 349 |
/** |
|
| 350 |
* @brief The constructor. |
|
| 351 |
*/ |
|
| 352 | ! |
DlnormDistributionsInterface() : DistributionsInterfaceBase() {}
|
| 353 | ||
| 354 |
/** |
|
| 355 |
* @brief The destructor. |
|
| 356 |
*/ |
|
| 357 | ! |
virtual ~DlnormDistributionsInterface() {}
|
| 358 | ||
| 359 |
/** |
|
| 360 |
* @brief Gets the ID of the interface base object. |
|
| 361 |
* @return The ID. |
|
| 362 |
*/ |
|
| 363 | ! |
virtual uint32_t get_id() { return this->id_m; }
|
| 364 | ||
| 365 |
/** |
|
| 366 |
* @brief Set the unique ID for the observed data object. |
|
| 367 |
* @param observed_data_id Unique ID for the observed data object. |
|
| 368 |
*/ |
|
| 369 | ! |
virtual bool set_observed_data(int observed_data_id) {
|
| 370 | ! |
this->interface_observed_data_id_m = observed_data_id; |
| 371 | ! |
return true; |
| 372 |
} |
|
| 373 | ||
| 374 |
/** |
|
| 375 |
* @brief Sets pointers for data observations, random effects, or priors. |
|
| 376 |
* |
|
| 377 |
* @param input_type String that sets whether the distribution type is for priors, random effects, or data. |
|
| 378 |
* @param ids Vector of unique ids for each linked parameter(s), derived |
|
| 379 |
* value(s), or observed data vector. |
|
| 380 |
*/ |
|
| 381 | ! |
virtual bool set_distribution_links(std::string input_type, Rcpp::IntegerVector ids){
|
| 382 | ! |
this->input_type_m = input_type; |
| 383 | ! |
this->key_m.resize(ids.size()); |
| 384 | ! |
for(int i=0; i<ids.size(); i++){
|
| 385 | ! |
this->key_m[i] = ids[i]; |
| 386 |
} |
|
| 387 | ! |
return true; |
| 388 |
} |
|
| 389 | ||
| 390 |
/** |
|
| 391 |
* @brief Evaluate lognormal probability density function (pdf). The natural |
|
| 392 |
* log of the pdf is returned. |
|
| 393 |
* @return The natural log of the probability density function (pdf) is |
|
| 394 |
* returned. |
|
| 395 |
*/ |
|
| 396 | ! |
virtual double evaluate() {
|
| 397 | ! |
fims_distributions::LogNormalLPDF<double> dlnorm; |
| 398 | ! |
dlnorm.x.resize(this->x.size()); |
| 399 | ! |
dlnorm.expected_values.resize(this->expected_values.size()); |
| 400 | ! |
dlnorm.log_sd.resize(this->log_sd.size()); |
| 401 | ! |
for(size_t i=0; i<x.size(); i++){
|
| 402 | ! |
dlnorm.x[i] = this->x[i].initial_value_m; |
| 403 |
} |
|
| 404 | ! |
for(size_t i=0; i<expected_values.size(); i++){
|
| 405 | ! |
dlnorm.expected_values[i] = this->expected_values[i].initial_value_m; |
| 406 |
} |
|
| 407 | ! |
for(size_t i=0; i<log_sd.size(); i++){
|
| 408 | ! |
dlnorm.log_sd[i] = this->log_sd[i].initial_value_m; |
| 409 |
} |
|
| 410 | ! |
return dlnorm.evaluate(); |
| 411 |
} |
|
| 412 | ||
| 413 |
/** |
|
| 414 |
* @brief Extracts the derived quantities from `Information` to the Rcpp |
|
| 415 |
* object. |
|
| 416 |
*/ |
|
| 417 | ! |
virtual void finalize() {
|
| 418 | ! |
if (this->finalized) {
|
| 419 |
//log warning that finalize has been called more than once. |
|
| 420 | ! |
FIMS_WARNING_LOG("LogNormalLPDF " + fims::to_string(this->id_m) + " has been finalized already.");
|
| 421 |
} |
|
| 422 | ||
| 423 | ! |
this->finalized = true; //indicate this has been called already |
| 424 | ||
| 425 |
std::shared_ptr<fims_info::Information<double> > info = |
|
| 426 | ! |
fims_info::Information<double>::GetInstance(); |
| 427 | ||
| 428 | ! |
fims_info::Information<double>::density_components_iterator it; |
| 429 | ||
| 430 |
//search for density component in Information |
|
| 431 | ! |
it = info->density_components.find(this->id_m); |
| 432 |
//if not found, just return |
|
| 433 | ! |
if (it == info->density_components.end()) {
|
| 434 | ! |
FIMS_WARNING_LOG("LogNormalLPDF " + fims::to_string(this->id_m) + " not found in Information.");
|
| 435 | ! |
return; |
| 436 |
} else {
|
|
| 437 |
std::shared_ptr<fims_distributions::LogNormalLPDF<double> > dlnorm = |
|
| 438 | ! |
std::dynamic_pointer_cast<fims_distributions::LogNormalLPDF<double> >(it->second); |
| 439 | ! |
this->lpdf_vec = Rcpp::NumericVector(dlnorm->lpdf_vec.size()); |
| 440 | ! |
for(R_xlen_t i=0; i < this->lpdf_vec.size(); i++) {
|
| 441 | ! |
this->lpdf_vec[i] = dlnorm->lpdf_vec[i]; |
| 442 |
} |
|
| 443 |
} |
|
| 444 |
} |
|
| 445 | ||
| 446 |
/** |
|
| 447 |
* @brief Converts the data to json representation for the output. |
|
| 448 |
* @return A string is returned specifying that the module relates to the |
|
| 449 |
* distribution interface with a log_normal distribution. It also returns the |
|
| 450 |
* ID and the natural log of the probability density function values |
|
| 451 |
* themselves. This string is formatted for a json file. |
|
| 452 |
*/ |
|
| 453 | ! |
virtual std::string to_json() {
|
| 454 | ! |
std::stringstream ss; |
| 455 | ||
| 456 | ! |
ss << "\"module\" : {\n";
|
| 457 | ! |
ss << " \"name\": \"LogNormalLPDF\",\n"; |
| 458 | ! |
ss << " \"type\": \"log_normal\",\n"; |
| 459 | ! |
ss << " \"id\": " << this->id_m << ",\n"; |
| 460 | ||
| 461 | ! |
ss << " \"density_component\": {\n";
|
| 462 | ! |
ss << " \"name\": \"lpdf_vec\",\n"; |
| 463 | ! |
ss << " \"values\":["; |
| 464 | ! |
if (this->lpdf_vec.size() == 0) {
|
| 465 | ! |
ss << "]\n"; |
| 466 |
} else {
|
|
| 467 | ! |
for(R_xlen_t i=0; i < this->lpdf_vec.size() - 1; i++) {
|
| 468 | ! |
ss << this->lpdf_vec[i] << ", "; |
| 469 |
} |
|
| 470 | ! |
ss << this->lpdf_vec[this->lpdf_vec.size() - 1] << "]\n"; |
| 471 |
} |
|
| 472 | ! |
ss << " }\n]"; |
| 473 | ||
| 474 | ! |
return ss.str(); |
| 475 |
} |
|
| 476 | ||
| 477 | ||
| 478 | ||
| 479 |
#ifdef TMB_MODEL |
|
| 480 | ||
| 481 |
template <typename Type> |
|
| 482 | ! |
bool add_to_fims_tmb_internal() {
|
| 483 |
std::shared_ptr<fims_info::Information<Type>> info = |
|
| 484 | ! |
fims_info::Information<Type>::GetInstance(); |
| 485 | ||
| 486 |
std::shared_ptr<fims_distributions::LogNormalLPDF<Type>> distribution = |
|
| 487 | ! |
std::make_shared<fims_distributions::LogNormalLPDF<Type>>(); |
| 488 | ||
| 489 |
// set relative info |
|
| 490 | ! |
distribution->id = this->id_m; |
| 491 | ! |
distribution->observed_data_id_m = |
| 492 | ! |
interface_observed_data_id_m; |
| 493 | ! |
distribution->input_type = this->input_type_m; |
| 494 | ! |
distribution->key.resize(this->key_m.size()); |
| 495 | ! |
for(size_t i=0; i<this->key_m.size(); i++){
|
| 496 | ! |
distribution->key[i] = this->key_m[i]; |
| 497 |
} |
|
| 498 | ! |
distribution->x.resize(this->x.size()); |
| 499 | ! |
for(size_t i=0; i<this->x.size(); i++){
|
| 500 | ! |
distribution->x[i] = this->x[i].initial_value_m; |
| 501 |
} |
|
| 502 |
// set relative info |
|
| 503 | ! |
distribution->expected_values.resize(this->expected_values.size()); |
| 504 | ! |
for(size_t i=0; i<this->expected_values.size(); i++){
|
| 505 | ! |
distribution->expected_values[i] = this->expected_values[i].initial_value_m; |
| 506 |
} |
|
| 507 | ! |
distribution->log_sd.resize(this->log_sd.size()); |
| 508 | ! |
for(size_t i=0; i<this->log_sd.size(); i++){
|
| 509 | ! |
distribution->log_sd[i] = this->log_sd[i].initial_value_m; |
| 510 | ! |
if(this->log_sd[i].estimated_m){
|
| 511 | ! |
info->RegisterParameterName("lognormal log_sd");
|
| 512 | ! |
info->RegisterParameter(distribution->log_sd[i]); |
| 513 |
} |
|
| 514 | ! |
if (this->log_sd[i].is_random_effect_m) {
|
| 515 | ! |
error("standard deviations cannot be set to random effects");
|
| 516 |
} |
|
| 517 |
} |
|
| 518 | ! |
info->variable_map[this->log_sd.id_m] = &(distribution)->log_sd; |
| 519 | ||
| 520 | ! |
info->density_components[distribution->id] = distribution; |
| 521 | ||
| 522 |
return true; |
|
| 523 |
} |
|
| 524 | ||
| 525 |
/** |
|
| 526 |
* @brief Adds the parameters to the TMB model. |
|
| 527 |
* @return A boolean of true. |
|
| 528 |
*/ |
|
| 529 | ! |
virtual bool add_to_fims_tmb() {
|
| 530 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 531 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 532 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 533 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 534 | ||
| 535 | ! |
return true; |
| 536 |
} |
|
| 537 | ||
| 538 |
#endif |
|
| 539 |
}; |
|
| 540 | ||
| 541 |
/** |
|
| 542 |
* @brief The Rcpp interface for Dmultinom to instantiate from R: |
|
| 543 |
* dmultinom_ <- methods::new(DmultinomDistribution). |
|
| 544 |
*/ |
|
| 545 |
class DmultinomDistributionsInterface : public DistributionsInterfaceBase {
|
|
| 546 |
public: |
|
| 547 |
/** |
|
| 548 |
* @brief Observed data, which should be a vector of length K of integers. |
|
| 549 |
*/ |
|
| 550 |
ParameterVector x; |
|
| 551 |
/** |
|
| 552 |
* @brief The expected values, which should be a vector of length K where |
|
| 553 |
* each value specifies the probability of class k. Note that, unlike in R, |
|
| 554 |
* these probabilities must sum to 1.0. |
|
| 555 |
*/ |
|
| 556 |
ParameterVector expected_values; |
|
| 557 |
/** |
|
| 558 |
* @brief The dimensions of the number of rows and columns of the |
|
| 559 |
* multivariate dataset. |
|
| 560 |
*/ |
|
| 561 |
Rcpp::NumericVector dims; |
|
| 562 |
/** |
|
| 563 |
* @brief The vector. TODO: document this more. |
|
| 564 |
*/ |
|
| 565 |
Rcpp::NumericVector lpdf_vec; /**< The vector */ |
|
| 566 | ||
| 567 |
/** |
|
| 568 |
* @brief The constructor. |
|
| 569 |
*/ |
|
| 570 | ! |
DmultinomDistributionsInterface() : DistributionsInterfaceBase() {}
|
| 571 | ||
| 572 |
/** |
|
| 573 |
* @brief The destructor. |
|
| 574 |
*/ |
|
| 575 | ! |
virtual ~DmultinomDistributionsInterface() {}
|
| 576 |
/** |
|
| 577 |
* @brief Gets the ID of the interface base object. |
|
| 578 |
* @return The ID. |
|
| 579 |
*/ |
|
| 580 | ! |
virtual uint32_t get_id() { return this->id_m; }
|
| 581 | ||
| 582 |
/** |
|
| 583 |
* @brief Set the unique ID for the observed data object. |
|
| 584 |
* @param observed_data_id Unique ID for the observed data object. |
|
| 585 |
*/ |
|
| 586 | ! |
virtual bool set_observed_data(int observed_data_id) {
|
| 587 | ! |
this->interface_observed_data_id_m = observed_data_id; |
| 588 | ! |
return true; |
| 589 |
} |
|
| 590 | ||
| 591 |
/** |
|
| 592 |
* @brief Sets pointers for data observations, random effects, or priors. |
|
| 593 |
* |
|
| 594 |
* @param input_type String that sets whether the distribution type is for priors, random effects, or data. |
|
| 595 |
* @param ids Vector of unique ids for each linked parameter(s), derived |
|
| 596 |
* value(s), or observed data vector. |
|
| 597 |
*/ |
|
| 598 | ! |
virtual bool set_distribution_links(std::string input_type, Rcpp::IntegerVector ids){
|
| 599 | ! |
this->input_type_m = input_type; |
| 600 | ! |
this->key_m.resize(ids.size()); |
| 601 | ! |
for(int i=0; i<ids.size(); i++){
|
| 602 | ! |
this->key_m[i] = ids[i]; |
| 603 |
} |
|
| 604 | ! |
return true; |
| 605 |
} |
|
| 606 | ||
| 607 |
/** |
|
| 608 |
* @brief Evaluate multinomial probability density function (pdf). The log of |
|
| 609 |
* the pdf is returned. |
|
| 610 |
* @return The natural log of the probability density function (pdf) is |
|
| 611 |
* returned. |
|
| 612 |
*/ |
|
| 613 | ! |
virtual double evaluate() {
|
| 614 | ! |
fims_distributions::MultinomialLPMF<double> dmultinom; |
| 615 |
// Declare TMBVector in this scope |
|
| 616 | ! |
dmultinom.x.resize(this->x.size()); |
| 617 | ! |
dmultinom.expected_values.resize(this->expected_values.size()); |
| 618 | ! |
for(size_t i=0; i<x.size(); i++){
|
| 619 | ! |
dmultinom.x[i] = this->x[i].initial_value_m; |
| 620 |
} |
|
| 621 | ! |
for(size_t i=0; i<expected_values.size(); i++){
|
| 622 | ! |
dmultinom.expected_values[i] = this->expected_values[i].initial_value_m; |
| 623 |
} |
|
| 624 | ! |
dmultinom.dims.resize(2); |
| 625 | ! |
dmultinom.dims[0] = this->dims[0]; |
| 626 | ! |
dmultinom.dims[1] = this->dims[1]; |
| 627 | ! |
return dmultinom.evaluate(); |
| 628 |
} |
|
| 629 | ||
| 630 |
#ifdef TMB_MODEL |
|
| 631 | ||
| 632 |
template <typename Type> |
|
| 633 | ! |
bool add_to_fims_tmb_internal() {
|
| 634 |
std::shared_ptr<fims_info::Information<Type>> info = |
|
| 635 | ! |
fims_info::Information<Type>::GetInstance(); |
| 636 | ||
| 637 |
std::shared_ptr<fims_distributions::MultinomialLPMF<Type>> distribution = |
|
| 638 | ! |
std::make_shared<fims_distributions::MultinomialLPMF<Type>>(); |
| 639 | ||
| 640 | ! |
distribution->id = this->id_m; |
| 641 | ! |
distribution->observed_data_id_m = |
| 642 | ! |
interface_observed_data_id_m; |
| 643 | ! |
distribution->input_type = this->input_type_m; |
| 644 | ! |
distribution->key.resize(this->key_m.size()); |
| 645 | ! |
for(size_t i=0; i<this->key_m.size(); i++){
|
| 646 | ! |
distribution->key[i] = this->key_m[i]; |
| 647 |
} |
|
| 648 | ! |
distribution->x.resize(this->x.size()); |
| 649 | ! |
for(size_t i=0; i<this->x.size(); i++){
|
| 650 | ! |
distribution->x[i] = this->x[i].initial_value_m; |
| 651 |
} |
|
| 652 |
// set relative info |
|
| 653 | ! |
distribution->expected_values.resize(this->expected_values.size()); |
| 654 | ! |
for(size_t i=0; i<this->expected_values.size(); i++){
|
| 655 | ! |
distribution->expected_values[i] = this->expected_values[i].initial_value_m; |
| 656 |
} |
|
| 657 | ! |
if(this->dims.size()>0){
|
| 658 | ! |
distribution->dims.resize(2); |
| 659 | ! |
distribution->dims[0] = this->dims[0]; |
| 660 | ! |
distribution->dims[1] = this->dims[1]; |
| 661 |
} |
|
| 662 | ||
| 663 | ! |
info->density_components[distribution->id] = distribution; |
| 664 | ||
| 665 |
return true; |
|
| 666 |
} |
|
| 667 | ||
| 668 | ! |
virtual bool add_to_fims_tmb() {
|
| 669 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 670 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 671 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 672 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 673 | ||
| 674 | ! |
return true; |
| 675 |
} |
|
| 676 | ||
| 677 |
#endif |
|
| 678 |
}; |
|
| 679 |
#endif |
| 1 |
/** |
|
| 2 |
* @file rcpp_fleet.hpp |
|
| 3 |
* @brief The Rcpp interface to declare fleets. Allows for the use of |
|
| 4 |
* methods::new() in R. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_FLEET_HPP |
|
| 10 |
#define FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_FLEET_HPP |
|
| 11 | ||
| 12 |
#include "../../../common/def.hpp" |
|
| 13 |
#include "../../../population_dynamics/fleet/fleet.hpp" |
|
| 14 |
#include "rcpp_interface_base.hpp" |
|
| 15 | ||
| 16 |
/** |
|
| 17 |
* @brief Rcpp interface that serves as the parent class for Rcpp fleet |
|
| 18 |
* interfaces. This type should be inherited and not called from R directly. |
|
| 19 |
*/ |
|
| 20 |
class FleetInterfaceBase : public FIMSRcppInterfaceBase {
|
|
| 21 |
public: |
|
| 22 |
/** |
|
| 23 |
* @brief The static id of the FleetInterfaceBase object. |
|
| 24 |
*/ |
|
| 25 |
static uint32_t id_g; |
|
| 26 |
/** |
|
| 27 |
* @brief The local id of the FleetInterfaceBase object. |
|
| 28 |
*/ |
|
| 29 |
uint32_t id; |
|
| 30 |
/** |
|
| 31 |
* @brief The map associating the IDs of FleetInterfaceBase to the objects. |
|
| 32 |
* This is a live object, which is an object that has been created and lives |
|
| 33 |
* in memory. |
|
| 34 |
*/ |
|
| 35 |
static std::map<uint32_t, FleetInterfaceBase*> live_objects; |
|
| 36 | ||
| 37 |
/** |
|
| 38 |
* @brief The constructor. |
|
| 39 |
*/ |
|
| 40 | ! |
FleetInterfaceBase() {
|
| 41 | ! |
this->id = FleetInterfaceBase::id_g++; |
| 42 |
/* Create instance of map: key is id and value is pointer to |
|
| 43 |
FleetInterfaceBase */ |
|
| 44 | ! |
FleetInterfaceBase::live_objects[this->id] = this; |
| 45 | ! |
FIMSRcppInterfaceBase::fims_interface_objects.push_back(this); |
| 46 |
} |
|
| 47 | ||
| 48 |
/** |
|
| 49 |
* @brief The destructor. |
|
| 50 |
*/ |
|
| 51 | ! |
virtual ~FleetInterfaceBase() {}
|
| 52 | ||
| 53 |
/** |
|
| 54 |
* @brief Get the ID for the child fleet interface objects to inherit. |
|
| 55 |
*/ |
|
| 56 |
virtual uint32_t get_id() = 0; |
|
| 57 |
}; |
|
| 58 |
// static id of the FleetInterfaceBase object |
|
| 59 |
uint32_t FleetInterfaceBase::id_g = 1; |
|
| 60 |
// local id of the FleetInterfaceBase object map relating the ID of the |
|
| 61 |
// FleetInterfaceBase to the FleetInterfaceBase objects |
|
| 62 |
std::map<uint32_t, FleetInterfaceBase*> FleetInterfaceBase::live_objects; |
|
| 63 | ||
| 64 |
/** |
|
| 65 |
* @brief The Rcpp interface for Fleet to instantiate from R: |
|
| 66 |
* fleet <- methods::new(Fleet) |
|
| 67 |
*/ |
|
| 68 |
class FleetInterface : public FleetInterfaceBase {
|
|
| 69 |
/** |
|
| 70 |
* @brief The ID of the observed age-composition data object. |
|
| 71 |
*/ |
|
| 72 | ! |
int interface_observed_agecomp_data_id_m = -999; |
| 73 |
/** |
|
| 74 |
* @brief The ID of the observed length-composition data object. |
|
| 75 |
*/ |
|
| 76 | ! |
int interface_observed_lengthcomp_data_id_m = -999; |
| 77 |
/** |
|
| 78 |
* @brief The ID of the observed index data object. |
|
| 79 |
*/ |
|
| 80 | ! |
int interface_observed_index_data_id_m = -999; |
| 81 |
/** |
|
| 82 |
* @brief The ID of the selectivity object. |
|
| 83 |
*/ |
|
| 84 | ! |
int interface_selectivity_id_m = -999; |
| 85 | ||
| 86 |
public: |
|
| 87 |
/** |
|
| 88 |
* @brief The name of the fleet. |
|
| 89 |
*/ |
|
| 90 | ! |
std::string name = "NA"; |
| 91 |
/** |
|
| 92 |
* @brief Is this fleet a survey, then true. If the fleet is a fishery, then |
|
| 93 |
* false, where false is the default. As of version 0.3.0, a fleet in FIMS |
|
| 94 |
* cannot accommodate both landings and index data, and thus must be |
|
| 95 |
* designated to be a fleet or a survey. This will be fixed in later |
|
| 96 |
* versions. |
|
| 97 |
*/ |
|
| 98 | ! |
bool is_survey = false; |
| 99 |
/** |
|
| 100 |
* @brief The number of age bins in the fleet data. |
|
| 101 |
*/ |
|
| 102 |
int nages; |
|
| 103 |
/** |
|
| 104 |
* @brief The number of length bins in the fleet data. |
|
| 105 |
*/ |
|
| 106 | ! |
int nlengths = 0; |
| 107 |
/** |
|
| 108 |
* @brief The number of years in the fleet data. |
|
| 109 |
*/ |
|
| 110 |
int nyears; |
|
| 111 |
/** |
|
| 112 |
* @brief The natural log of the catchability parameter for this fleet. |
|
| 113 |
*/ |
|
| 114 |
ParameterVector log_q; |
|
| 115 |
/** |
|
| 116 |
* @brief The vector of the natural log of fishing mortality rates for this |
|
| 117 |
* fleet. |
|
| 118 |
*/ |
|
| 119 |
ParameterVector log_Fmort; |
|
| 120 |
/** |
|
| 121 |
* @brief The vector of natural log of the expected index of abundance for the fleet. |
|
| 122 |
*/ |
|
| 123 |
ParameterVector log_expected_index; |
|
| 124 |
/** |
|
| 125 |
* @brief The vector of expected catch-at-age in numbers for the fleet. |
|
| 126 |
*/ |
|
| 127 |
ParameterVector proportion_catch_numbers_at_age; |
|
| 128 |
/** |
|
| 129 |
* @brief The vector of expected catch-at-length in numbers for the fleet. |
|
| 130 |
*/ |
|
| 131 |
ParameterVector proportion_catch_numbers_at_length; |
|
| 132 |
/** |
|
| 133 |
* @brief The vector of conversions to go from age to length, i.e., the age-to-length-conversion matrix. |
|
| 134 |
*/ |
|
| 135 |
ParameterVector age_length_conversion_matrix; |
|
| 136 |
/** |
|
| 137 |
* @brief Should catchability (q) be estimated? The default is false. |
|
| 138 |
*/ |
|
| 139 | ! |
bool estimate_q = false; |
| 140 |
/** |
|
| 141 |
* @brief Is catchability (q) a random effect? The default is false. |
|
| 142 |
*/ |
|
| 143 | ! |
bool random_q = false; |
| 144 |
// derived quantities |
|
| 145 |
/** |
|
| 146 |
* @brief Derived catch-at-age in numbers. |
|
| 147 |
*/ |
|
| 148 |
Rcpp::NumericVector derived_cnaa; |
|
| 149 |
/** |
|
| 150 |
* @brief Derived catch-at-length in numbers. |
|
| 151 |
*/ |
|
| 152 |
Rcpp::NumericVector derived_cnal; |
|
| 153 |
/** |
|
| 154 |
* @brief Derived catch-at-age in weight (mt). |
|
| 155 |
*/ |
|
| 156 |
Rcpp::NumericVector derived_cwaa; |
|
| 157 |
/** |
|
| 158 |
* @brief Derived index. |
|
| 159 |
*/ |
|
| 160 |
Rcpp::NumericVector derived_index; |
|
| 161 |
/** |
|
| 162 |
* @brief Derived age compositions. |
|
| 163 |
*/ |
|
| 164 |
Rcpp::NumericVector derived_age_composition; |
|
| 165 |
/** |
|
| 166 |
* @brief Derived length compositions. |
|
| 167 |
*/ |
|
| 168 |
Rcpp::NumericVector derived_length_composition; |
|
| 169 | ||
| 170 |
/** |
|
| 171 |
* @brief The constructor. |
|
| 172 |
*/ |
|
| 173 | ! |
FleetInterface() : FleetInterfaceBase() {}
|
| 174 | ||
| 175 |
/** |
|
| 176 |
* @brief The destructor. |
|
| 177 |
*/ |
|
| 178 | ! |
virtual ~FleetInterface() {}
|
| 179 | ||
| 180 |
/** |
|
| 181 |
* @brief Gets the ID of the interface base object. |
|
| 182 |
* @return The ID. |
|
| 183 |
*/ |
|
| 184 | ! |
virtual uint32_t get_id() { return this->id; }
|
| 185 | ||
| 186 |
/** |
|
| 187 |
* @brief Set the unique ID for the observed age-composition data object. |
|
| 188 |
* @param observed_agecomp_data_id Unique ID for the observed data object. |
|
| 189 |
*/ |
|
| 190 | ! |
void SetObservedAgeCompData(int observed_agecomp_data_id) {
|
| 191 | ! |
interface_observed_agecomp_data_id_m = observed_agecomp_data_id; |
| 192 |
} |
|
| 193 | ||
| 194 |
/** |
|
| 195 |
* @brief Set the unique ID for the observed length-composition data object. |
|
| 196 |
* @param observed_lengthcomp_data_id Unique ID for the observed data object. |
|
| 197 |
*/ |
|
| 198 | ! |
void SetObservedLengthCompData(int observed_lengthcomp_data_id) {
|
| 199 | ! |
interface_observed_lengthcomp_data_id_m = observed_lengthcomp_data_id; |
| 200 |
} |
|
| 201 | ||
| 202 |
/** |
|
| 203 |
* @brief Set the unique ID for the observed index data object. |
|
| 204 |
* @param observed_index_data_id Unique ID for the observed data object. |
|
| 205 |
*/ |
|
| 206 | ! |
void SetObservedIndexData(int observed_index_data_id) {
|
| 207 | ! |
interface_observed_index_data_id_m = observed_index_data_id; |
| 208 |
} |
|
| 209 | ||
| 210 |
/** |
|
| 211 |
* @brief Set the unique ID for the selectivity object. |
|
| 212 |
* @param selectivity_id Unique ID for the observed object. |
|
| 213 |
*/ |
|
| 214 | ! |
void SetSelectivity(int selectivity_id) {
|
| 215 | ! |
interface_selectivity_id_m = selectivity_id; |
| 216 |
} |
|
| 217 | ||
| 218 |
/** |
|
| 219 |
* @brief Get the unique ID for the observed age-composition data object. |
|
| 220 |
*/ |
|
| 221 | ! |
int GetObservedAgeCompDataID() {
|
| 222 | ! |
return interface_observed_agecomp_data_id_m; |
| 223 |
} |
|
| 224 | ||
| 225 |
/** |
|
| 226 |
* @brief Get the unique ID for the observed length-composition data |
|
| 227 |
* object. |
|
| 228 |
*/ |
|
| 229 | ! |
int GetObservedLengthCompDataID() {
|
| 230 | ! |
return interface_observed_lengthcomp_data_id_m; |
| 231 |
} |
|
| 232 | ||
| 233 |
/** |
|
| 234 |
* @brief Get the unique id for the observed index data object. |
|
| 235 |
*/ |
|
| 236 | ! |
int GetObservedIndexDataID() {
|
| 237 | ! |
return interface_observed_index_data_id_m; |
| 238 |
} |
|
| 239 | ||
| 240 |
/** |
|
| 241 |
* @brief Extracts the derived quantities from `Information` to the Rcpp |
|
| 242 |
* object. |
|
| 243 |
*/ |
|
| 244 | ! |
virtual void finalize() {
|
| 245 | ! |
if (this->finalized) {
|
| 246 |
//log warning that finalize has been called more than once. |
|
| 247 | ! |
FIMS_WARNING_LOG("Fleet " + fims::to_string(this->id) + " has been finalized already.");
|
| 248 |
} |
|
| 249 | ||
| 250 | ! |
this->finalized = true; //indicate this has been called already |
| 251 | ||
| 252 |
std::shared_ptr<fims_info::Information<double> > info = |
|
| 253 | ! |
fims_info::Information<double>::GetInstance(); |
| 254 | ||
| 255 | ! |
fims_info::Information<double>::fleet_iterator it; |
| 256 | ||
| 257 | ! |
it = info->fleets.find(this->id); |
| 258 | ||
| 259 | ! |
if (it == info->fleets.end()) {
|
| 260 | ! |
FIMS_WARNING_LOG("Fleet " + fims::to_string(this->id) + " not found in Information.");
|
| 261 | ! |
return; |
| 262 |
} else {
|
|
| 263 | ||
| 264 |
std::shared_ptr<fims_popdy::Fleet<double> > fleet = |
|
| 265 | ! |
std::dynamic_pointer_cast<fims_popdy::Fleet<double> >(it->second); |
| 266 | ||
| 267 | ||
| 268 | ! |
for (size_t i = 0; i < this->log_Fmort.size(); i++) {
|
| 269 | ! |
if (this->log_Fmort[i].estimated_m) {
|
| 270 | ! |
this->log_Fmort[i].final_value_m = fleet->log_Fmort[i]; |
| 271 |
} else {
|
|
| 272 | ! |
this->log_Fmort[i].final_value_m = this->log_Fmort[i].initial_value_m; |
| 273 |
} |
|
| 274 |
} |
|
| 275 | ||
| 276 | ! |
for (size_t i = 0; i < this->log_q.size(); i++) {
|
| 277 | ! |
if (this->log_q[i].estimated_m) {
|
| 278 | ! |
this->log_q[i].final_value_m = fleet->log_q[i]; |
| 279 |
} else {
|
|
| 280 | ! |
this->log_q[i].final_value_m = this->log_q[i].initial_value_m; |
| 281 |
} |
|
| 282 |
} |
|
| 283 | ||
| 284 | ! |
this->derived_cnaa = Rcpp::NumericVector(fleet->catch_numbers_at_age.size()); |
| 285 | ! |
for (R_xlen_t i = 0; i < this->derived_cnaa.size(); i++) {
|
| 286 | ! |
this->derived_cnaa[i] = fleet->catch_numbers_at_age[i]; |
| 287 |
} |
|
| 288 | ||
| 289 | ! |
this->derived_cnal = Rcpp::NumericVector(fleet->catch_numbers_at_length.size()); |
| 290 | ! |
for (R_xlen_t i = 0; i < this->derived_cnal.size(); i++) {
|
| 291 | ! |
this->derived_cnal[i] = fleet->catch_numbers_at_length[i]; |
| 292 |
} |
|
| 293 | ||
| 294 | ! |
this->derived_cwaa = Rcpp::NumericVector(fleet->catch_weight_at_age.size()); |
| 295 | ! |
for (R_xlen_t i = 0; i < this->derived_cwaa.size(); i++) {
|
| 296 | ! |
this->derived_cwaa[i] = fleet->catch_weight_at_age[i]; |
| 297 |
} |
|
| 298 | ||
| 299 | ! |
this->derived_age_composition = Rcpp::NumericVector(fleet->proportion_catch_numbers_at_age.size()); |
| 300 | ! |
for (R_xlen_t i = 0; i < this->derived_age_composition.size(); i++) {
|
| 301 | ! |
this->derived_age_composition[i] = fleet->proportion_catch_numbers_at_age[i]; |
| 302 |
} |
|
| 303 | ||
| 304 | ! |
this->derived_length_composition = Rcpp::NumericVector(fleet->proportion_catch_numbers_at_length.size()); |
| 305 | ! |
for (R_xlen_t i = 0; i < this->derived_length_composition.size(); i++) {
|
| 306 | ! |
this->derived_length_composition[i] = fleet->proportion_catch_numbers_at_length[i]; |
| 307 |
} |
|
| 308 | ||
| 309 | ! |
this->derived_index = Rcpp::NumericVector(fleet->expected_index.size()); |
| 310 | ! |
for (R_xlen_t i = 0; i < this->derived_index.size(); i++) {
|
| 311 | ! |
this->derived_index[i] = fleet->expected_index[i]; |
| 312 |
} |
|
| 313 | ||
| 314 |
} |
|
| 315 | ||
| 316 |
} |
|
| 317 | ||
| 318 |
/** |
|
| 319 |
* @brief Converts the data to json representation for the output. |
|
| 320 |
* @return A string is returned specifying that the module relates to the |
|
| 321 |
* fleet interface. It returns the name and ID as well as all derived |
|
| 322 |
* quantities and parameter estimates. This string is formatted for a json |
|
| 323 |
* file. |
|
| 324 |
*/ |
|
| 325 | ! |
virtual std::string to_json() {
|
| 326 | ! |
std::stringstream ss; |
| 327 | ||
| 328 | ! |
ss << "\"module\" : {\n";
|
| 329 | ! |
ss << " \"name\" : \"Fleet\",\n"; |
| 330 | ||
| 331 | ! |
ss << " \"type\" : \"fleet\",\n"; |
| 332 | ! |
ss << " \"tag\" : \"" << this->name << "\",\n"; |
| 333 | ! |
ss << " \"id\": " << this->id << ",\n"; |
| 334 | ||
| 335 | ! |
ss << " \"parameter\": {\n";
|
| 336 | ! |
ss << " \"name\": \"log_Fmort\",\n"; |
| 337 | ! |
ss << " \"id\":" << this->log_Fmort.id_m << ",\n"; |
| 338 | ! |
ss << " \"type\": \"vector\",\n"; |
| 339 | ! |
ss << " \"values\": " << this->log_Fmort << "\n},\n"; |
| 340 | ||
| 341 | ! |
ss << " \"parameter\": {\n";
|
| 342 | ! |
ss << " \"name\": \"log_q\",\n"; |
| 343 | ! |
ss << " \"id\":" << this->log_q.id_m << ",\n"; |
| 344 | ! |
ss << " \"type\": \"vector\",\n"; |
| 345 | ! |
ss << " \"values\": " << this->log_q << "\n},\n"; |
| 346 | ||
| 347 | ! |
ss << " \"derived_quantity\": {\n";
|
| 348 | ! |
ss << " \"name\": \"cnaa\",\n"; |
| 349 | ! |
ss << " \"values\":["; |
| 350 | ! |
if (this->derived_cnaa.size() == 0) {
|
| 351 | ! |
ss << "]\n"; |
| 352 |
} else {
|
|
| 353 | ! |
for (R_xlen_t i = 0; i < this->derived_cnaa.size() - 1; i++) {
|
| 354 | ! |
ss << this->derived_cnaa[i] << ", "; |
| 355 |
} |
|
| 356 | ! |
ss << this->derived_cnaa[this->derived_cnaa.size() - 1] << "]\n"; |
| 357 |
} |
|
| 358 | ! |
ss << " },\n"; |
| 359 | ||
| 360 | ! |
ss << " \"derived_quantity\": {\n";
|
| 361 | ! |
ss << " \"name\": \"cnal\",\n"; |
| 362 | ! |
ss << " \"values\":["; |
| 363 | ! |
if (this->derived_cnal.size() == 0) {
|
| 364 | ! |
ss << "]\n"; |
| 365 |
} else {
|
|
| 366 | ! |
for (R_xlen_t i = 0; i < this->derived_cnal.size() - 1; i++) {
|
| 367 | ! |
ss << this->derived_cnal[i] << ", "; |
| 368 |
} |
|
| 369 | ! |
ss << this->derived_cnal[this->derived_cnal.size() - 1] << "]\n"; |
| 370 |
} |
|
| 371 | ! |
ss << " },\n"; |
| 372 | ||
| 373 | ! |
ss << " \"derived_quantity\": {\n";
|
| 374 | ! |
ss << " \"name\": \"cwaa\",\n"; |
| 375 | ! |
ss << " \"values\":["; |
| 376 | ! |
if (this->derived_cwaa.size() == 0) {
|
| 377 | ! |
ss << "]\n"; |
| 378 |
} else {
|
|
| 379 | ! |
for (R_xlen_t i = 0; i < this->derived_cwaa.size() - 1; i++) {
|
| 380 | ! |
ss << this->derived_cwaa[i] << ", "; |
| 381 |
} |
|
| 382 | ! |
ss << this->derived_cwaa[this->derived_cwaa.size() - 1] << "]\n"; |
| 383 |
} |
|
| 384 | ! |
ss << " },\n"; |
| 385 | ||
| 386 | ||
| 387 | ! |
ss << " \"derived_quantity\": {\n";
|
| 388 | ! |
ss << " \"name\": \"age_composition \",\n"; |
| 389 | ! |
ss << " \"values\":["; |
| 390 | ! |
if (this->derived_age_composition.size() == 0) {
|
| 391 | ! |
ss << "]\n"; |
| 392 |
} else {
|
|
| 393 | ! |
for (R_xlen_t i = 0; i < this->derived_age_composition.size() - 1; i++) {
|
| 394 | ! |
ss << this->derived_age_composition[i] << ", "; |
| 395 |
} |
|
| 396 | ! |
ss << this->derived_age_composition[this->derived_age_composition.size() - 1] << "]\n"; |
| 397 |
} |
|
| 398 | ! |
ss << " },\n"; |
| 399 | ||
| 400 | ! |
ss << " \"derived_quantity\": {\n";
|
| 401 | ! |
ss << " \"name\": \"length_composition \",\n"; |
| 402 | ! |
ss << " \"values\":["; |
| 403 | ! |
if (this->derived_length_composition.size() == 0) {
|
| 404 | ! |
ss << "]\n"; |
| 405 |
} else {
|
|
| 406 | ! |
for (R_xlen_t i = 0; i < this->derived_length_composition.size() - 1; i++) {
|
| 407 | ! |
ss << this->derived_length_composition[i] << ", "; |
| 408 |
} |
|
| 409 | ! |
ss << this->derived_length_composition[this->derived_length_composition.size() - 1] << "]\n"; |
| 410 |
} |
|
| 411 | ! |
ss << " },\n"; |
| 412 | ||
| 413 | ! |
ss << " \"derived_quantity\": {\n";
|
| 414 | ! |
ss << " \"name\": \"index \",\n"; |
| 415 | ! |
ss << " \"values\":["; |
| 416 | ! |
if (this->derived_index.size() == 0) {
|
| 417 | ! |
ss << "]\n"; |
| 418 |
} else {
|
|
| 419 | ! |
for (R_xlen_t i = 0; i < this->derived_index.size() - 1; i++) {
|
| 420 | ! |
ss << this->derived_index[i] << ", "; |
| 421 |
} |
|
| 422 | ! |
ss << this->derived_index[this->derived_index.size() - 1] << "]\n"; |
| 423 |
} |
|
| 424 | ! |
ss << " },\n"; |
| 425 | ||
| 426 | ! |
return ss.str(); |
| 427 | ||
| 428 |
} |
|
| 429 | ||
| 430 | ||
| 431 | ||
| 432 |
#ifdef TMB_MODEL |
|
| 433 | ||
| 434 |
template <typename Type> |
|
| 435 | ! |
bool add_to_fims_tmb_internal() {
|
| 436 |
std::shared_ptr<fims_info::Information<Type> > info = |
|
| 437 | ! |
fims_info::Information<Type>::GetInstance(); |
| 438 | ||
| 439 |
std::shared_ptr<fims_popdy::Fleet<Type> > fleet = |
|
| 440 | ! |
std::make_shared<fims_popdy::Fleet<Type> >(); |
| 441 | ||
| 442 |
// set relative info |
|
| 443 | ! |
fleet->id = this->id; |
| 444 | ! |
fleet->is_survey = this->is_survey; |
| 445 | ! |
fleet->nages = this->nages; |
| 446 | ! |
fleet->nlengths = this->nlengths; |
| 447 | ! |
fleet->nyears = this->nyears; |
| 448 | ! |
fleet->fleet_observed_agecomp_data_id_m = |
| 449 | ! |
interface_observed_agecomp_data_id_m; |
| 450 | ! |
fleet->fleet_observed_lengthcomp_data_id_m = |
| 451 | ! |
interface_observed_lengthcomp_data_id_m; |
| 452 | ! |
fleet->fleet_observed_index_data_id_m = interface_observed_index_data_id_m; |
| 453 | ! |
fleet->fleet_selectivity_id_m = interface_selectivity_id_m; |
| 454 | ||
| 455 | ! |
fleet->log_q.resize(this->log_q.size()); |
| 456 | ! |
for (size_t i = 0; i < this->log_q.size(); i++) {
|
| 457 | ! |
fleet->log_q[i] = this->log_q[i].initial_value_m; |
| 458 | ||
| 459 | ! |
if (this->log_q[i].estimated_m) {
|
| 460 | ! |
info->RegisterParameterName("log_q");
|
| 461 | ! |
if (this->log_q[i].is_random_effect_m) {
|
| 462 | ! |
info->RegisterRandomEffect(fleet->log_q[i]); |
| 463 |
} else {
|
|
| 464 | ! |
info->RegisterParameter(fleet->log_q[i]); |
| 465 |
} |
|
| 466 |
} |
|
| 467 |
} |
|
| 468 | ||
| 469 | ||
| 470 | ! |
fleet->log_Fmort.resize(this->log_Fmort.size()); |
| 471 | ! |
for (size_t i = 0; i < log_Fmort.size(); i++) {
|
| 472 | ! |
fleet->log_Fmort[i] = this->log_Fmort[i].initial_value_m; |
| 473 | ||
| 474 | ! |
if (this->log_Fmort[i].estimated_m) {
|
| 475 | ! |
info->RegisterParameterName("log_Fmort");
|
| 476 | ! |
if (this->log_Fmort[i].is_random_effect_m) {
|
| 477 | ! |
info->RegisterRandomEffect(fleet->log_Fmort[i]); |
| 478 |
} else {
|
|
| 479 | ! |
info->RegisterParameter(fleet->log_Fmort[i]); |
| 480 |
} |
|
| 481 |
} |
|
| 482 |
} |
|
| 483 |
//add to variable_map |
|
| 484 | ! |
info->variable_map[this->log_Fmort.id_m] = &(fleet)->log_Fmort; |
| 485 | ||
| 486 |
//exp_catch |
|
| 487 | ! |
fleet->log_expected_index.resize(nyears); // assume index is for all ages. |
| 488 | ! |
info->variable_map[this->log_expected_index.id_m] = &(fleet)->log_expected_index; |
| 489 | ! |
fleet->proportion_catch_numbers_at_age.resize(nyears * nages); |
| 490 | ! |
info->variable_map[this->proportion_catch_numbers_at_age.id_m] = &(fleet)->proportion_catch_numbers_at_age; |
| 491 | ||
| 492 | ! |
if(this->nlengths > 0){
|
| 493 | ! |
fleet->proportion_catch_numbers_at_length.resize(nyears * nlengths); |
| 494 | ! |
fleet->age_length_conversion_matrix.resize(nages * nlengths); |
| 495 | ! |
for (size_t i = 0; i < fleet->age_length_conversion_matrix.size(); i++){
|
| 496 | ! |
fleet->age_length_conversion_matrix[i] = this->age_length_conversion_matrix[i].initial_value_m; |
| 497 |
|
|
| 498 | ! |
if (this->age_length_conversion_matrix[i].estimated_m) {
|
| 499 | ! |
info->RegisterParameterName("age_length_conversion_matrix");
|
| 500 | ! |
if (this->age_length_conversion_matrix[i].is_random_effect_m) {
|
| 501 | ! |
info->RegisterRandomEffect(fleet->age_length_conversion_matrix[i]); |
| 502 |
} else {
|
|
| 503 | ! |
info->RegisterParameter(fleet->age_length_conversion_matrix[i]); |
| 504 |
} |
|
| 505 |
} |
|
| 506 |
} |
|
| 507 | ! |
info->variable_map[this->age_length_conversion_matrix.id_m] = &(fleet)->age_length_conversion_matrix; |
| 508 | ! |
info->variable_map[this->proportion_catch_numbers_at_length.id_m] = &(fleet)->proportion_catch_numbers_at_length; |
| 509 |
} |
|
| 510 | ||
| 511 |
// add to Information |
|
| 512 | ! |
info->fleets[fleet->id] = fleet; |
| 513 | ||
| 514 |
return true; |
|
| 515 |
} |
|
| 516 | ||
| 517 |
/** |
|
| 518 |
* @brief Adds the parameters to the TMB model. |
|
| 519 |
* @return A boolean of true. |
|
| 520 |
*/ |
|
| 521 | ! |
virtual bool add_to_fims_tmb() {
|
| 522 | ! |
FIMS_INFO_LOG("adding Fleet object to TMB");
|
| 523 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 524 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 525 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 526 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 527 | ||
| 528 | ! |
return true; |
| 529 |
} |
|
| 530 | ||
| 531 |
#endif |
|
| 532 |
}; |
|
| 533 | ||
| 534 |
#endif |
| 1 |
/** |
|
| 2 |
* @file rcpp_growth.hpp |
|
| 3 |
* @brief The Rcpp interface to declare different types of growth, e.g., |
|
| 4 |
* empirical weight-at-age data. Allows for the use of methods::new() in R. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_GROWTH_HPP |
|
| 10 |
#define FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_GROWTH_HPP |
|
| 11 | ||
| 12 |
#include "../../../population_dynamics/growth/growth.hpp" |
|
| 13 |
#include "rcpp_interface_base.hpp" |
|
| 14 | ||
| 15 |
/** |
|
| 16 |
* @brief Rcpp interface that serves as the parent class for Rcpp growth |
|
| 17 |
* interfaces. This type should be inherited and not called from R directly. |
|
| 18 |
*/ |
|
| 19 |
class GrowthInterfaceBase : public FIMSRcppInterfaceBase {
|
|
| 20 |
public: |
|
| 21 |
/** |
|
| 22 |
* @brief The static id of the GrowthInterfaceBase object. |
|
| 23 |
*/ |
|
| 24 |
static uint32_t id_g; |
|
| 25 |
/** |
|
| 26 |
* @brief The local id of the GrowthInterfaceBase object. |
|
| 27 |
*/ |
|
| 28 |
uint32_t id; |
|
| 29 |
/** |
|
| 30 |
* @brief The map associating the IDs of GrowthInterfaceBase to the objects. |
|
| 31 |
* This is a live object, which is an object that has been created and lives |
|
| 32 |
* in memory. |
|
| 33 |
*/ |
|
| 34 |
static std::map<uint32_t, GrowthInterfaceBase*> live_objects; |
|
| 35 | ||
| 36 |
/** |
|
| 37 |
* @brief The constructor. |
|
| 38 |
*/ |
|
| 39 | ! |
GrowthInterfaceBase() {
|
| 40 | ! |
this->id = GrowthInterfaceBase::id_g++; |
| 41 |
/* Create instance of map: key is id and value is pointer to |
|
| 42 |
GrowthInterfaceBase */ |
|
| 43 | ! |
GrowthInterfaceBase::live_objects[this->id] = this; |
| 44 | ! |
FIMSRcppInterfaceBase::fims_interface_objects.push_back(this); |
| 45 |
} |
|
| 46 | ||
| 47 |
/** |
|
| 48 |
* @brief The destructor. |
|
| 49 |
*/ |
|
| 50 | ! |
virtual ~GrowthInterfaceBase() {}
|
| 51 | ||
| 52 |
/** |
|
| 53 |
* @brief Get the ID for the child growth interface objects to inherit. |
|
| 54 |
*/ |
|
| 55 |
virtual uint32_t get_id() = 0; |
|
| 56 | ||
| 57 |
/** |
|
| 58 |
* @brief A method for each child growth interface object to inherit so |
|
| 59 |
* each growth option can have an evaluate() function. |
|
| 60 |
*/ |
|
| 61 |
virtual double evaluate(double age) = 0; |
|
| 62 |
}; |
|
| 63 |
// static id of the GrowthInterfaceBase object |
|
| 64 |
uint32_t GrowthInterfaceBase::id_g = 1; |
|
| 65 |
// local id of the GrowthInterfaceBase object map relating the ID of the |
|
| 66 |
// GrowthInterfaceBase to the GrowthInterfaceBase objects |
|
| 67 |
std::map<uint32_t, GrowthInterfaceBase*> GrowthInterfaceBase::live_objects; |
|
| 68 | ||
| 69 |
/** |
|
| 70 |
* @brief Rcpp interface for EWAAgrowth to instantiate the object from R: |
|
| 71 |
* ewaa <- methods::new(EWAAgrowth). Where, EWAA stands for empirical weight at |
|
| 72 |
* age and growth is not actually estimated. |
|
| 73 |
*/ |
|
| 74 |
class EWAAGrowthInterface : public GrowthInterfaceBase {
|
|
| 75 |
public: |
|
| 76 |
/** |
|
| 77 |
* @brief Weights (mt) for each age class. |
|
| 78 |
*/ |
|
| 79 |
std::vector<double> weights; |
|
| 80 |
/** |
|
| 81 |
* @brief Ages (years) for each age class. |
|
| 82 |
*/ |
|
| 83 |
std::vector<double> ages; |
|
| 84 |
/** |
|
| 85 |
* @brief A map of empirical weight-at-age values. TODO: describe this |
|
| 86 |
* parameter better. |
|
| 87 |
*/ |
|
| 88 |
std::map<double, double> ewaa; |
|
| 89 |
/** |
|
| 90 |
* @brief Have weight and age vectors been set? The default is false. |
|
| 91 |
*/ |
|
| 92 | ! |
bool initialized = false; |
| 93 | ||
| 94 |
/** |
|
| 95 |
* @brief The constructor. |
|
| 96 |
*/ |
|
| 97 | ! |
EWAAGrowthInterface() : GrowthInterfaceBase() {}
|
| 98 | ||
| 99 |
/** |
|
| 100 |
* @brief The destructor. |
|
| 101 |
*/ |
|
| 102 | ! |
virtual ~EWAAGrowthInterface() {}
|
| 103 | ||
| 104 |
/** |
|
| 105 |
* @brief Gets the ID of the interface base object. |
|
| 106 |
* @return The ID. |
|
| 107 |
*/ |
|
| 108 | ! |
virtual uint32_t get_id() { return this->id; }
|
| 109 | ||
| 110 |
/** |
|
| 111 |
* @brief Create a map of input numeric vectors. |
|
| 112 |
* @param weights Type vector of weights. |
|
| 113 |
* @param ages Type vector of ages. |
|
| 114 |
* @return std::map<T, T>. |
|
| 115 |
*/ |
|
| 116 | ! |
inline std::map<double, double> make_map(std::vector<double> ages, |
| 117 |
std::vector<double> weights) {
|
|
| 118 | ! |
std::map<double, double> mymap; |
| 119 | ! |
for (uint32_t i = 0; i < ages.size(); i++) {
|
| 120 | ! |
mymap.insert(std::pair<double, double>(ages[i], weights[i])); |
| 121 |
} |
|
| 122 | ! |
return mymap; |
| 123 |
} |
|
| 124 | ||
| 125 |
/** |
|
| 126 |
* @brief Evaluate the growth using empirical weight at age. |
|
| 127 |
* @param age Age. TODO: Document this better. |
|
| 128 |
* @details This can be called from R using ewaagrowth.evaluate(age). |
|
| 129 |
*/ |
|
| 130 | ! |
virtual double evaluate(double age) {
|
| 131 | ! |
fims_popdy::EWAAgrowth<double> EWAAGrowth; |
| 132 | ||
| 133 | ! |
if (initialized == false) {
|
| 134 | ! |
this->ewaa = make_map(this->ages, this->weights); |
| 135 |
// Check that ages and weights vector are the same length |
|
| 136 | ! |
if (this->ages.size() != this->weights.size()) {
|
| 137 | ! |
Rcpp::stop("ages and weights must be the same length");
|
| 138 |
} |
|
| 139 | ! |
initialized = true; |
| 140 |
} else {
|
|
| 141 | ! |
Rcpp::stop("this empirical weight at age object is already initialized");
|
| 142 |
} |
|
| 143 | ! |
EWAAGrowth.ewaa = this->ewaa; |
| 144 | ! |
return EWAAGrowth.evaluate(age); |
| 145 |
} |
|
| 146 |
|
|
| 147 |
/** |
|
| 148 |
* @brief Converts the data to json representation for the output. |
|
| 149 |
* @return A string is returned specifying that the module relates to the |
|
| 150 |
* growth interface with empirical weight at age. It also returns the ID, the |
|
| 151 |
* rank of 1, the dimensions, age bins, and the calculated values themselves. |
|
| 152 |
* This string is formatted for a json file. |
|
| 153 |
*/ |
|
| 154 | ! |
virtual std::string to_json() {
|
| 155 | ! |
std::stringstream ss; |
| 156 | ! |
ss << "\"module\" : {\n";
|
| 157 | ! |
ss << " \"name\": \"growth\",\n"; |
| 158 | ! |
ss << " \"type\" : \"EWAA\",\n"; |
| 159 | ! |
ss << " \"id\":" << this->id << ",\n"; |
| 160 | ! |
ss << " \"rank\": " << 1 << ",\n"; |
| 161 | ! |
ss << " \"dimensions\": [" << this->weights.size() << "],\n"; |
| 162 | ||
| 163 | ! |
ss << " \"ages\": ["; |
| 164 | ! |
for (size_t i = 0; i < ages.size() - 1; i++) {
|
| 165 | ! |
ss << ages[i] << ", "; |
| 166 |
} |
|
| 167 | ! |
ss << ages[ages.size() - 1] << "],\n"; |
| 168 | ||
| 169 | ! |
ss << " \"values\": ["; |
| 170 | ! |
for (size_t i = 0; i < weights.size() - 1; i++) {
|
| 171 | ! |
ss << weights[i] << ", "; |
| 172 |
} |
|
| 173 | ! |
ss << weights[weights.size() - 1] << "]\n"; |
| 174 | ! |
ss << "}"; |
| 175 | ! |
return ss.str(); |
| 176 |
} |
|
| 177 |
|
|
| 178 |
#ifdef TMB_MODEL |
|
| 179 | ||
| 180 |
template <typename Type> |
|
| 181 | ! |
bool add_to_fims_tmb_internal() {
|
| 182 |
std::shared_ptr<fims_info::Information<Type> > info = |
|
| 183 | ! |
fims_info::Information<Type>::GetInstance(); |
| 184 | ||
| 185 |
std::shared_ptr<fims_popdy::EWAAgrowth<Type> > ewaa_growth = |
|
| 186 | ! |
std::make_shared<fims_popdy::EWAAgrowth<Type> >(); |
| 187 | ||
| 188 |
// set relative info |
|
| 189 | ! |
ewaa_growth->id = this->id; |
| 190 | ! |
ewaa_growth->ewaa = make_map(this->ages, this->weights); // this->ewaa; |
| 191 |
// add to Information |
|
| 192 | ! |
info->growth_models[ewaa_growth->id] = ewaa_growth; |
| 193 | ||
| 194 |
return true; |
|
| 195 |
} |
|
| 196 | ||
| 197 |
/** |
|
| 198 |
* @brief Adds the parameters to the TMB model. |
|
| 199 |
* @return A boolean of true. |
|
| 200 |
*/ |
|
| 201 | ! |
virtual bool add_to_fims_tmb() {
|
| 202 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 203 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 204 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 205 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 206 | ||
| 207 | ! |
return true; |
| 208 |
} |
|
| 209 | ||
| 210 |
#endif |
|
| 211 |
}; |
|
| 212 | ||
| 213 |
#endif |
| 1 |
/** |
|
| 2 |
* @file rcpp_interface_base.hpp |
|
| 3 |
* @brief The Rcpp interface to declare objects that are used ubiquitously |
|
| 4 |
* throughout the Rcpp interface, e.g., Parameters and ParameterVectors. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_INTERFACE_BASE_HPP |
|
| 10 |
#define FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_INTERFACE_BASE_HPP |
|
| 11 | ||
| 12 |
#include <RcppCommon.h> |
|
| 13 |
#include <map> |
|
| 14 |
#include <vector> |
|
| 15 | ||
| 16 |
#include "../../../common/def.hpp" |
|
| 17 |
#include "../../../common/information.hpp" |
|
| 18 |
#include "../../interface.hpp" |
|
| 19 | ||
| 20 |
#define RCPP_NO_SUGAR |
|
| 21 |
#include <Rcpp.h> |
|
| 22 | ||
| 23 |
/** |
|
| 24 |
* @brief An Rcpp interface that defines the Parameter class. |
|
| 25 |
* |
|
| 26 |
* @details An Rcpp interface class that defines the interface between R and |
|
| 27 |
* C++ for a parameter type. |
|
| 28 |
*/ |
|
| 29 |
class Parameter {
|
|
| 30 |
public: |
|
| 31 |
/** |
|
| 32 |
* @brief The static ID of the Parameter object. |
|
| 33 |
*/ |
|
| 34 |
static uint32_t id_g; |
|
| 35 |
/** |
|
| 36 |
* @brief The local ID of the Parameter object. |
|
| 37 |
*/ |
|
| 38 |
uint32_t id_m; |
|
| 39 |
/** |
|
| 40 |
* @brief The initial value of the parameter. |
|
| 41 |
*/ |
|
| 42 | ! |
double initial_value_m = 0.0; |
| 43 |
/** |
|
| 44 |
* @brief The final value of the parameter. |
|
| 45 |
*/ |
|
| 46 | ! |
double final_value_m = 0.0; |
| 47 |
/** |
|
| 48 |
* @brief The minimum possible parameter value, where the default is negative |
|
| 49 |
* infinity. |
|
| 50 |
*/ |
|
| 51 | ! |
double min_m = -std::numeric_limits<double>::infinity(); |
| 52 |
/** |
|
| 53 |
* @brief The maximum possible parameter value, where the default is positive |
|
| 54 |
* infinity. |
|
| 55 |
*/ |
|
| 56 | ! |
double max_m = std::numeric_limits<double>::infinity(); |
| 57 |
/** |
|
| 58 |
* @brief Is the parameter a random effect? The default is false. |
|
| 59 |
*/ |
|
| 60 | ! |
bool is_random_effect_m = false; |
| 61 |
/** |
|
| 62 |
* @brief Should the parameter be estimated? The default is false. |
|
| 63 |
*/ |
|
| 64 | ! |
bool estimated_m = false; |
| 65 | ||
| 66 |
/** |
|
| 67 |
* @brief The constructor for initializing a parameter. |
|
| 68 |
*/ |
|
| 69 |
Parameter(double value, double min, double max, bool estimated) |
|
| 70 |
: id_m(Parameter::id_g++), initial_value_m(value), min_m(min), max_m(max), estimated_m(estimated) {}
|
|
| 71 | ||
| 72 |
/** |
|
| 73 |
* @brief The constructor for initializing a parameter. |
|
| 74 |
*/ |
|
| 75 | ! |
Parameter(const Parameter& other) : |
| 76 | ! |
id_m(other.id_m), initial_value_m(other.initial_value_m), |
| 77 | ! |
final_value_m(other.final_value_m), |
| 78 | ! |
min_m(other.min_m), max_m(other.max_m), |
| 79 | ! |
is_random_effect_m(other.is_random_effect_m), |
| 80 | ! |
estimated_m(other.estimated_m) {}
|
| 81 | ||
| 82 |
/** |
|
| 83 |
* @brief The constructor for initializing a parameter. |
|
| 84 |
*/ |
|
| 85 | ! |
Parameter& operator=(const Parameter& right) {
|
| 86 |
// Check for self-assignment! |
|
| 87 | ! |
if (this == &right) // Same object? |
| 88 | ! |
return *this; // Yes, so skip assignment, and just return *this. |
| 89 | ! |
this->id_m = right.id_m; |
| 90 | ! |
this->initial_value_m = right.initial_value_m; |
| 91 | ! |
this->estimated_m = right.estimated_m; |
| 92 | ! |
this->min_m = right.min_m; |
| 93 | ! |
this->max_m = right.max_m; |
| 94 | ! |
this->is_random_effect_m = right.is_random_effect_m; |
| 95 | ! |
return *this; |
| 96 |
} |
|
| 97 | ||
| 98 |
|
|
| 99 | ||
| 100 |
/** |
|
| 101 |
* @brief The constructor for initializing a parameter. |
|
| 102 |
*/ |
|
| 103 | ! |
Parameter(double value) {
|
| 104 | ! |
initial_value_m = value; |
| 105 | ! |
id_m = Parameter::id_g++; |
| 106 |
} |
|
| 107 | ||
| 108 |
/** |
|
| 109 |
* @brief The constructor for initializing a parameter. |
|
| 110 |
* @details Set value to 0 when there is no input value. |
|
| 111 |
*/ |
|
| 112 | ! |
Parameter() {
|
| 113 | ! |
initial_value_m = 0; |
| 114 | ! |
id_m = Parameter::id_g++;} |
| 115 |
}; |
|
| 116 |
/** |
|
| 117 |
* @brief The unique ID for the variable map that points to a fims::Vector. |
|
| 118 |
*/ |
|
| 119 |
uint32_t Parameter::id_g = 0; |
|
| 120 | ||
| 121 |
/** |
|
| 122 |
* @brief Output for std::ostream& for a parameter. |
|
| 123 |
* |
|
| 124 |
* @param out The stream. |
|
| 125 |
* @param p A parameter. |
|
| 126 |
* @return std::ostream& |
|
| 127 |
*/ |
|
| 128 | ! |
std::ostream& operator<<(std::ostream& out, const Parameter& p) {
|
| 129 | ! |
out << "{id:" << p.id_m << ",\nvalue:" << p.initial_value_m
|
| 130 | ! |
<< ",\nestimated_value:" << p.final_value_m << ",\nmin:" |
| 131 | ! |
<< p.min_m << ",\nmax:" << p.max_m << ",\nestimated:" << p.estimated_m << "\n}"; |
| 132 | ! |
return out; |
| 133 |
} |
|
| 134 | ||
| 135 |
/** |
|
| 136 |
* @brief An Rcpp interface class that defines the ParameterVector class. |
|
| 137 |
* |
|
| 138 |
* @details An Rcpp interface class that defines the interface between R and |
|
| 139 |
* C++ for a parameter vector type. |
|
| 140 |
*/ |
|
| 141 |
class ParameterVector{
|
|
| 142 |
public: |
|
| 143 |
/** |
|
| 144 |
* @brief The static ID of the Parameter object. |
|
| 145 |
*/ |
|
| 146 |
static uint32_t id_g; |
|
| 147 |
/** |
|
| 148 |
* @brief Parameter storage. |
|
| 149 |
*/ |
|
| 150 |
std::shared_ptr<std::vector<Parameter> > storage_m; |
|
| 151 |
/** |
|
| 152 |
* @brief The local ID of the Parameter object. |
|
| 153 |
*/ |
|
| 154 |
uint32_t id_m; |
|
| 155 | ||
| 156 |
/** |
|
| 157 |
* @brief The constructor. |
|
| 158 |
*/ |
|
| 159 | ! |
ParameterVector(){
|
| 160 | ! |
this->id_m = ParameterVector::id_g++; |
| 161 | ! |
this->storage_m = std::make_shared<std::vector<Parameter> >(); |
| 162 | ! |
this->storage_m->resize(1); //push_back(Rcpp::wrap(p)); |
| 163 |
} |
|
| 164 | ||
| 165 |
/** |
|
| 166 |
* @brief The constructor. |
|
| 167 |
*/ |
|
| 168 | ! |
ParameterVector(const ParameterVector& other) : |
| 169 | ! |
storage_m(other.storage_m), id_m(other.id_m) {}
|
| 170 | ||
| 171 |
/** |
|
| 172 |
* @brief The constructor. |
|
| 173 |
*/ |
|
| 174 | ! |
ParameterVector(size_t size ){
|
| 175 | ! |
this->id_m = ParameterVector::id_g++; |
| 176 | ! |
this->storage_m = std::make_shared<std::vector<Parameter> >(); |
| 177 | ! |
this->storage_m->resize(size); |
| 178 | ! |
for (size_t i = 0; i < size; i++) {
|
| 179 | ! |
storage_m->at(i) = Parameter(); |
| 180 |
} |
|
| 181 |
} |
|
| 182 | ||
| 183 |
/** |
|
| 184 |
* @brief The constructor for initializing a parameter vector. |
|
| 185 |
* @param x A numeric vector. |
|
| 186 |
* @param size The number of elements to copy over. |
|
| 187 |
*/ |
|
| 188 | ! |
ParameterVector(Rcpp::NumericVector x, size_t size){
|
| 189 | ! |
this->id_m = ParameterVector::id_g++; |
| 190 | ! |
this->storage_m = std::make_shared<std::vector<Parameter> >(); |
| 191 | ! |
this->resize(size); |
| 192 | ! |
for (size_t i = 0; i < size; i++) {
|
| 193 | ! |
storage_m->at(i).initial_value_m = x[i]; |
| 194 |
} |
|
| 195 |
} |
|
| 196 | ||
| 197 |
/** |
|
| 198 |
* @brief The constructor for initializing a parameter vector. |
|
| 199 |
* @param v A vector of doubles. |
|
| 200 |
*/ |
|
| 201 |
ParameterVector(const fims::Vector<double>& v) {
|
|
| 202 |
this->id_m = ParameterVector::id_g++; |
|
| 203 |
this->storage_m = std::make_shared<std::vector<Parameter> >(); |
|
| 204 |
this->storage_m->resize(v.size()); |
|
| 205 |
for (size_t i = 0; i < v.size(); i++) {
|
|
| 206 |
storage_m->at(i).initial_value_m = v[i]; |
|
| 207 |
} |
|
| 208 |
} |
|
| 209 | ||
| 210 |
/** |
|
| 211 |
* @brief Destroy the Parameter Vector object. |
|
| 212 |
* |
|
| 213 |
*/ |
|
| 214 | ! |
virtual ~ParameterVector(){}
|
| 215 | ||
| 216 |
/** |
|
| 217 |
* @brief Gets the ID of the ParameterVector object. |
|
| 218 |
*/ |
|
| 219 | ! |
virtual uint32_t get_id() { return this->id_m; }
|
| 220 | ||
| 221 |
/** |
|
| 222 |
* @brief The accessor where the first index starts is zero. |
|
| 223 |
* @param pos The position of the ParameterVector that you want returned. |
|
| 224 |
*/ |
|
| 225 | ! |
inline Parameter& operator[](size_t pos) {
|
| 226 | ! |
return this->storage_m->at(pos); |
| 227 |
} |
|
| 228 | ||
| 229 |
/** |
|
| 230 |
* @brief The accessor where the first index starts at one. This function is |
|
| 231 |
* for calling accessing from R. |
|
| 232 |
* @param pos The position of the ParameterVector that you want returned. |
|
| 233 |
*/ |
|
| 234 | ! |
SEXP at(R_xlen_t pos){
|
| 235 | ! |
if (static_cast<size_t>(pos) == 0 || |
| 236 | ! |
static_cast<size_t>(pos) > this->storage_m->size()) {
|
| 237 | ! |
Rcpp::Rcout << "ParameterVector: Index out of range.\n"; |
| 238 | ! |
FIMS_ERROR_LOG(fims::to_string(pos) + "!<" + fims::to_string(this->size())); |
| 239 | ! |
return NULL; |
| 240 |
} |
|
| 241 | ! |
return Rcpp::wrap(this->storage_m->at(pos - 1)); |
| 242 |
} |
|
| 243 | ||
| 244 |
/** |
|
| 245 |
* @brief An internal accessor for calling a position of a ParameterVector |
|
| 246 |
* from R. |
|
| 247 |
* @param pos An integer specifying the position of the ParameterVector |
|
| 248 |
* you want returned. The first position is one and the last position is |
|
| 249 |
* the same as the size of the ParameterVector. |
|
| 250 |
*/ |
|
| 251 | ! |
Parameter& get(size_t pos) {
|
| 252 | ! |
if (pos >= this->storage_m->size()) {
|
| 253 | ! |
Rcpp::Rcout << "ParameterVector: Index out of range.\n"; |
| 254 | ! |
throw std::invalid_argument("ParameterVector: Index out of range");
|
| 255 |
} |
|
| 256 | ! |
return (this->storage_m->at(pos)); |
| 257 |
} |
|
| 258 | ||
| 259 |
/** |
|
| 260 |
* @brief An internal setter for setting a position of a ParameterVector |
|
| 261 |
* from R. |
|
| 262 |
* @param pos An integer specifying the position of the ParameterVector |
|
| 263 |
* you want to set. The first position is one and the last position is the |
|
| 264 |
* same as the size of the ParameterVector. |
|
| 265 |
* @param p A numeric value specifying the value to set position `pos` to |
|
| 266 |
* in the ParameterVector. |
|
| 267 |
*/ |
|
| 268 | ! |
void set(size_t pos, const Parameter& p) {
|
| 269 | ! |
this->storage_m->at(pos) = p; |
| 270 |
} |
|
| 271 | ||
| 272 |
/** |
|
| 273 |
* @brief Returns the size of a ParameterVector. |
|
| 274 |
*/ |
|
| 275 | ! |
size_t size() {
|
| 276 | ! |
return this->storage_m->size(); |
| 277 |
} |
|
| 278 | ||
| 279 |
/** |
|
| 280 |
* @brief Resizes a ParameterVector to the desired length. |
|
| 281 |
* @param size An integer specifying the desired length for the |
|
| 282 |
* ParameterVector to be resized to. |
|
| 283 |
*/ |
|
| 284 | ! |
void resize(size_t size) {
|
| 285 | ! |
this->storage_m->resize(size); |
| 286 |
} |
|
| 287 | ||
| 288 |
/** |
|
| 289 |
* @brief Sets all Parameters within a ParameterVector as estimable. |
|
| 290 |
* |
|
| 291 |
* @param estimable A boolean specifying if all Parameters within the |
|
| 292 |
* ParameterVector should be estimated within the model. A value of true |
|
| 293 |
* leads to all Parameters being estimated. |
|
| 294 |
*/ |
|
| 295 | ! |
void set_all_estimable(bool estimable){
|
| 296 | ! |
for (size_t i = 0; i < this->storage_m->size(); i++) {
|
| 297 | ! |
storage_m->at(i).estimated_m = estimable; |
| 298 |
} |
|
| 299 |
} |
|
| 300 | ||
| 301 |
/** |
|
| 302 |
* @brief Sets all Parameters within a ParameterVector as random effects. |
|
| 303 |
* |
|
| 304 |
* @param random A boolean specifying if all Parameters within the |
|
| 305 |
* ParameterVector should be designated as random effects. A value of true |
|
| 306 |
* leads to all Parameters being random effects. |
|
| 307 |
*/ |
|
| 308 | ! |
void set_all_random(bool random){
|
| 309 | ! |
for (size_t i = 0; i < this->storage_m->size(); i++) {
|
| 310 | ! |
storage_m->at(i).is_random_effect_m = random; |
| 311 |
} |
|
| 312 |
} |
|
| 313 | ||
| 314 |
/** |
|
| 315 |
* @brief Sets the value of all Parameters in the ParameterVector to the |
|
| 316 |
* provided value. |
|
| 317 |
* |
|
| 318 |
* @param value A double specifying the value to set all Parameters to |
|
| 319 |
* within the ParameterVector. |
|
| 320 |
*/ |
|
| 321 | ! |
void fill(double value){
|
| 322 | ! |
for (size_t i = 0; i < this->storage_m->size(); i++) {
|
| 323 | ! |
storage_m->at(i).initial_value_m = value; |
| 324 |
} |
|
| 325 |
} |
|
| 326 | ||
| 327 |
/** |
|
| 328 |
* @brief Assigns the given values to the minimum value of all elements in |
|
| 329 |
* the vector. |
|
| 330 |
* |
|
| 331 |
* @param value The value to be assigned. |
|
| 332 |
*/ |
|
| 333 |
void fill_min(double value){
|
|
| 334 |
for (size_t i = 0; i < this->storage_m->size(); i++) {
|
|
| 335 |
storage_m->at(i).min_m = value; |
|
| 336 |
} |
|
| 337 |
} |
|
| 338 | ||
| 339 |
/** |
|
| 340 |
* @brief Assigns the given values to the maximum value of all elements in |
|
| 341 |
* the vector. |
|
| 342 |
* |
|
| 343 |
* @param value The value to be assigned. |
|
| 344 |
*/ |
|
| 345 |
void fill_max(double value){
|
|
| 346 |
for (size_t i = 0; i < this->storage_m->size(); i++) {
|
|
| 347 |
storage_m->at(i).max_m = value; |
|
| 348 |
} |
|
| 349 |
} |
|
| 350 | ||
| 351 |
/** |
|
| 352 |
* @brief The printing methods for a ParameterVector. |
|
| 353 |
* |
|
| 354 |
*/ |
|
| 355 | ! |
void show() {
|
| 356 | ! |
Rcpp::Rcout << this->storage_m->data() << "\n"; |
| 357 | ||
| 358 | ! |
for (size_t i = 0; i < this->storage_m->size(); i++) {
|
| 359 | ! |
Rcpp::Rcout << storage_m->at(i) << " "; |
| 360 |
} |
|
| 361 |
} |
|
| 362 | ||
| 363 |
}; |
|
| 364 |
uint32_t ParameterVector::id_g = 0; |
|
| 365 | ||
| 366 |
/** |
|
| 367 |
* @brief Output for std::ostream& for a ParameterVector. |
|
| 368 |
* |
|
| 369 |
* @param out The stream. |
|
| 370 |
* @param v A ParameterVector. |
|
| 371 |
* @return std::ostream& |
|
| 372 |
*/ |
|
| 373 | ! |
std::ostream& operator<<(std::ostream& out, ParameterVector& v) {
|
| 374 | ! |
out << "["; |
| 375 | ! |
size_t size = v.size(); |
| 376 | ! |
for (size_t i = 0; i < size - 1; i++) {
|
| 377 | ! |
out << v[i] << ", "; |
| 378 |
} |
|
| 379 | ! |
out << v[size - 1] << "]"; |
| 380 | ! |
return out; |
| 381 |
} |
|
| 382 | ||
| 383 |
/** |
|
| 384 |
*@brief Base class for all interface objects. |
|
| 385 |
*/ |
|
| 386 | ! |
class FIMSRcppInterfaceBase {
|
| 387 |
public: |
|
| 388 |
/** |
|
| 389 |
* @brief Is the object already finalized? The default is false. |
|
| 390 |
*/ |
|
| 391 | ! |
bool finalized = false; |
| 392 |
/** |
|
| 393 |
* @brief FIMS interface object vectors. |
|
| 394 |
*/ |
|
| 395 |
static std::vector<FIMSRcppInterfaceBase *> fims_interface_objects; |
|
| 396 |
/** |
|
| 397 |
* @brief A virtual method to inherit to add objects to the TMB model. |
|
| 398 |
*/ |
|
| 399 | ! |
virtual bool add_to_fims_tmb() {
|
| 400 | ! |
Rcpp::Rcout << "fims_rcpp_interface_base::add_to_fims_tmb(): Not yet " |
| 401 |
"implemented.\n"; |
|
| 402 | ! |
return false; |
| 403 |
} |
|
| 404 | ||
| 405 |
/** |
|
| 406 |
* @brief Extracts derived quantities back to the Rcpp interface object from |
|
| 407 |
* the Information object. |
|
| 408 |
*/ |
|
| 409 | ! |
virtual void finalize() {
|
| 410 |
} |
|
| 411 | ||
| 412 |
/** |
|
| 413 |
* @brief Convert the data to json representation for the output. |
|
| 414 |
*/ |
|
| 415 | ! |
virtual std::string to_json() {
|
| 416 | ! |
return ""; |
| 417 |
} |
|
| 418 |
}; |
|
| 419 |
std::vector<FIMSRcppInterfaceBase *> |
|
| 420 |
FIMSRcppInterfaceBase::fims_interface_objects; |
|
| 421 | ||
| 422 |
#endif |
| 1 |
/** |
|
| 2 |
* @file rcpp_maturity.hpp |
|
| 3 |
* @brief The Rcpp interface to declare different maturity options, e.g., |
|
| 4 |
* logistic. Allows for the use of methods::new() in R. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_MATURITY_HPP |
|
| 10 |
#define FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_MATURITY_HPP |
|
| 11 | ||
| 12 |
#include "../../../population_dynamics/maturity/maturity.hpp" |
|
| 13 |
#include "rcpp_interface_base.hpp" |
|
| 14 | ||
| 15 |
/** |
|
| 16 |
* @brief Rcpp interface that serves as the parent class for Rcpp maturity |
|
| 17 |
* interfaces. This type should be inherited and not called from R directly. |
|
| 18 |
*/ |
|
| 19 |
class MaturityInterfaceBase : public FIMSRcppInterfaceBase {
|
|
| 20 |
public: |
|
| 21 |
/** |
|
| 22 |
* @brief The static id of the MaturityInterfaceBase object. |
|
| 23 |
*/ |
|
| 24 |
static uint32_t id_g; |
|
| 25 |
/** |
|
| 26 |
* @brief The local id of the MaturityInterfaceBase object. |
|
| 27 |
*/ |
|
| 28 |
uint32_t id; |
|
| 29 |
/** |
|
| 30 |
* @brief The map associating the IDs of MaturityInterfaceBase to the objects. |
|
| 31 |
* This is a live object, which is an object that has been created and lives |
|
| 32 |
* in memory. |
|
| 33 |
*/ |
|
| 34 |
static std::map<uint32_t, MaturityInterfaceBase*> live_objects; |
|
| 35 | ||
| 36 |
/** |
|
| 37 |
* @brief The constructor. |
|
| 38 |
*/ |
|
| 39 | ! |
MaturityInterfaceBase() {
|
| 40 | ! |
this->id = MaturityInterfaceBase::id_g++; |
| 41 |
/* Create instance of map: key is id and value is pointer to |
|
| 42 |
MaturityInterfaceBase */ |
|
| 43 | ! |
MaturityInterfaceBase::live_objects[this->id] = this; |
| 44 | ! |
FIMSRcppInterfaceBase::fims_interface_objects.push_back(this); |
| 45 |
} |
|
| 46 | ||
| 47 |
/** |
|
| 48 |
* @brief The destructor. |
|
| 49 |
*/ |
|
| 50 | ! |
virtual ~MaturityInterfaceBase() {}
|
| 51 | ||
| 52 |
/** |
|
| 53 |
* @brief Get the ID for the child maturity interface objects to inherit. |
|
| 54 |
*/ |
|
| 55 |
virtual uint32_t get_id() = 0; |
|
| 56 | ||
| 57 |
/** |
|
| 58 |
* @brief A method for each child maturity interface object to inherit so |
|
| 59 |
* each maturity option can have an evaluate() function. |
|
| 60 |
*/ |
|
| 61 |
virtual double evaluate(double x) = 0; |
|
| 62 |
}; |
|
| 63 |
// static id of the MaturityInterfaceBase object |
|
| 64 |
uint32_t MaturityInterfaceBase::id_g = 1; |
|
| 65 |
// local id of the MaturityInterfaceBase object map relating the ID of the |
|
| 66 |
// MaturityInterfaceBase to the MaturityInterfaceBase objects |
|
| 67 |
std::map<uint32_t, MaturityInterfaceBase*> MaturityInterfaceBase::live_objects; |
|
| 68 | ||
| 69 |
/** |
|
| 70 |
* @brief Rcpp interface for logistic maturity to instantiate the object from R: |
|
| 71 |
* logistic_maturity <- methods::new(logistic_maturity). |
|
| 72 |
*/ |
|
| 73 |
class LogisticMaturityInterface : public MaturityInterfaceBase {
|
|
| 74 |
public: |
|
| 75 |
/** |
|
| 76 |
* @brief The index value at which the response reaches 0.5. |
|
| 77 |
*/ |
|
| 78 |
ParameterVector inflection_point; |
|
| 79 |
/** |
|
| 80 |
* @brief The width of the curve at the inflection point. |
|
| 81 |
*/ |
|
| 82 |
ParameterVector slope; |
|
| 83 | ||
| 84 |
/** |
|
| 85 |
* @brief The constructor. |
|
| 86 |
*/ |
|
| 87 | ! |
LogisticMaturityInterface() : MaturityInterfaceBase() {}
|
| 88 | ||
| 89 |
/** |
|
| 90 |
* @brief The destructor. |
|
| 91 |
*/ |
|
| 92 | ! |
virtual ~LogisticMaturityInterface() {}
|
| 93 | ||
| 94 |
/** |
|
| 95 |
* @brief Gets the ID of the interface base object. |
|
| 96 |
* @return The ID. |
|
| 97 |
*/ |
|
| 98 | ! |
virtual uint32_t get_id() { return this->id; }
|
| 99 | ||
| 100 |
/** |
|
| 101 |
* @brief Evaluate maturity using the logistic function. |
|
| 102 |
* @param x The independent variable in the logistic function (e.g., age or |
|
| 103 |
* size in maturity). |
|
| 104 |
*/ |
|
| 105 | ! |
virtual double evaluate(double x) {
|
| 106 | ! |
fims_popdy::LogisticMaturity<double> LogisticMat; |
| 107 | ! |
LogisticMat.inflection_point.resize(1); |
| 108 | ! |
LogisticMat.inflection_point[0] = this->inflection_point[0].initial_value_m; |
| 109 | ! |
LogisticMat.slope.resize(1); |
| 110 | ! |
LogisticMat.slope[0] = this->slope[0].initial_value_m; |
| 111 | ! |
return LogisticMat.evaluate(x); |
| 112 |
} |
|
| 113 | ||
| 114 |
/** |
|
| 115 |
* @brief Extracts derived quantities back to the Rcpp interface object from |
|
| 116 |
* the Information object. |
|
| 117 |
*/ |
|
| 118 | ! |
virtual void finalize() {
|
| 119 | ! |
if (this->finalized) {
|
| 120 |
//log warning that finalize has been called more than once. |
|
| 121 | ! |
FIMS_WARNING_LOG("Logistic Maturity " + fims::to_string(this->id) + " has been finalized already.");
|
| 122 |
} |
|
| 123 | ||
| 124 | ! |
this->finalized = true; //indicate this has been called already |
| 125 | ||
| 126 |
std::shared_ptr<fims_info::Information<double> > info = |
|
| 127 | ! |
fims_info::Information<double>::GetInstance(); |
| 128 | ||
| 129 | ! |
fims_info::Information<double>::maturity_models_iterator it; |
| 130 | ||
| 131 |
//search for maturity in Information |
|
| 132 | ! |
it = info->maturity_models.find(this->id); |
| 133 |
//if not found, just return |
|
| 134 | ! |
if (it == info->maturity_models.end()) {
|
| 135 | ! |
FIMS_WARNING_LOG("Logistic Maturity " + fims::to_string(this->id) + " not found in Information.");
|
| 136 | ! |
return; |
| 137 |
} else {
|
|
| 138 |
std::shared_ptr<fims_popdy::LogisticMaturity<double> > mat = |
|
| 139 | ! |
std::dynamic_pointer_cast<fims_popdy::LogisticMaturity<double> >(it->second); |
| 140 | ||
| 141 | ! |
for (size_t i = 0; i < inflection_point.size(); i++) {
|
| 142 | ! |
if (this->inflection_point[i].estimated_m) {
|
| 143 | ! |
this->inflection_point[i].final_value_m = mat->inflection_point[i]; |
| 144 |
} else {
|
|
| 145 | ! |
this->inflection_point[i].final_value_m = this->inflection_point[i].initial_value_m; |
| 146 |
} |
|
| 147 |
} |
|
| 148 | ||
| 149 | ! |
for (size_t i = 0; i < slope.size(); i++) {
|
| 150 | ! |
if (this->slope[i].estimated_m) {
|
| 151 | ! |
this->slope[i].final_value_m = mat->slope[i]; |
| 152 |
} else {
|
|
| 153 | ! |
this->slope[i].final_value_m = this->slope[i].initial_value_m; |
| 154 |
} |
|
| 155 |
} |
|
| 156 |
} |
|
| 157 |
} |
|
| 158 | ||
| 159 |
/** |
|
| 160 |
* @brief Converts the data to json representation for the output. |
|
| 161 |
* @return A string is returned specifying that the module relates to the |
|
| 162 |
* maturity interface with logistic maturity. It also returns the ID and the |
|
| 163 |
* parameters. This string is formatted for a json file. |
|
| 164 |
*/ |
|
| 165 | ! |
virtual std::string to_json() {
|
| 166 | ! |
std::stringstream ss; |
| 167 | ! |
ss << "\"module\" : {\n";
|
| 168 | ! |
ss << " \"name\": \"maturity\",\n"; |
| 169 | ! |
ss << " \"type\": \"logistic\",\n"; |
| 170 | ! |
ss << " \"id\": " << this->id << ",\n"; |
| 171 | ||
| 172 | ! |
ss << " \"parameter\": {\n";
|
| 173 | ! |
ss << " \"name\": \"inflection_point\",\n"; |
| 174 | ! |
ss << " \"id\":" << this->inflection_point.id_m << ",\n"; |
| 175 | ! |
ss << " \"type\": \"vector\",\n"; |
| 176 | ! |
ss << " \"values\":" << this->inflection_point << ",\n"; |
| 177 | ||
| 178 | ! |
ss << " \"parameter\": {\n";
|
| 179 | ! |
ss << " \"name\": \"slope\",\n"; |
| 180 | ! |
ss << " \"id\":" << this->slope.id_m << ",\n"; |
| 181 | ! |
ss << " \"type\": \"vector\",\n"; |
| 182 | ! |
ss << " \"values\":" << this->slope << ",\n"; |
| 183 | ||
| 184 | ! |
ss << "}"; |
| 185 | ||
| 186 | ! |
return ss.str(); |
| 187 |
} |
|
| 188 | ||
| 189 |
#ifdef TMB_MODEL |
|
| 190 | ||
| 191 |
template <typename Type> |
|
| 192 | ! |
bool add_to_fims_tmb_internal() {
|
| 193 |
std::shared_ptr<fims_info::Information<Type> > info = |
|
| 194 | ! |
fims_info::Information<Type>::GetInstance(); |
| 195 | ||
| 196 |
std::shared_ptr<fims_popdy::LogisticMaturity<Type> > maturity = |
|
| 197 | ! |
std::make_shared<fims_popdy::LogisticMaturity<Type> >(); |
| 198 | ||
| 199 |
// set relative info |
|
| 200 | ! |
maturity->id = this->id; |
| 201 | ! |
std::stringstream ss; |
| 202 | ! |
maturity->inflection_point.resize(this->inflection_point.size()); |
| 203 | ! |
for (size_t i = 0; i < this->inflection_point.size(); i++) {
|
| 204 | ! |
maturity->inflection_point[i] = this->inflection_point[i].initial_value_m; |
| 205 | ! |
if (this->inflection_point[i].estimated_m) {
|
| 206 | ! |
ss.str("");
|
| 207 | ! |
ss << "maturity.inflection_point." << this->id << "." << i; |
| 208 | ! |
info->RegisterParameterName(ss.str()); |
| 209 | ! |
if (this->inflection_point[i].is_random_effect_m) {
|
| 210 | ! |
info->RegisterRandomEffect(maturity->inflection_point[i]); |
| 211 |
} else {
|
|
| 212 | ! |
info->RegisterParameter(maturity->inflection_point[i]); |
| 213 |
} |
|
| 214 |
} |
|
| 215 |
} |
|
| 216 | ||
| 217 | ! |
maturity->slope.resize(this->slope.size()); |
| 218 | ! |
for (size_t i = 0; i < this->slope.size(); i++) {
|
| 219 | ! |
maturity->slope[i] = this->slope[i].initial_value_m; |
| 220 | ! |
if (this->slope[i].estimated_m) {
|
| 221 | ! |
ss.str("");
|
| 222 | ! |
ss << "maturity.slope_" << this->id << "." << i; |
| 223 | ! |
info->RegisterParameterName(ss.str()); |
| 224 | ! |
if (this->slope[i].is_random_effect_m) {
|
| 225 | ! |
info->RegisterRandomEffect(maturity->slope[i]); |
| 226 |
} else {
|
|
| 227 | ! |
info->RegisterParameter(maturity->slope[i]); |
| 228 |
} |
|
| 229 |
} |
|
| 230 |
} |
|
| 231 | ||
| 232 |
// add to Information |
|
| 233 | ! |
info->maturity_models[maturity->id] = maturity; |
| 234 | ||
| 235 |
return true; |
|
| 236 |
} |
|
| 237 | ||
| 238 |
/** |
|
| 239 |
* @brief Adds the parameters to the TMB model. |
|
| 240 |
* @return A boolean of true. |
|
| 241 |
*/ |
|
| 242 | ! |
virtual bool add_to_fims_tmb() {
|
| 243 | ! |
FIMS_INFO_LOG("adding Maturity object to TMB");
|
| 244 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 245 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 246 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 247 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 248 | ||
| 249 | ! |
return true; |
| 250 |
} |
|
| 251 | ||
| 252 |
#endif |
|
| 253 |
}; |
|
| 254 | ||
| 255 |
#endif |
| 1 |
/** |
|
| 2 |
* @file rcpp_population.hpp |
|
| 3 |
* @brief The Rcpp interface to declare different types of populations. Allows |
|
| 4 |
* for the use of methods::new() in R. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_POPULATION_HPP |
|
| 10 |
#define FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_POPULATION_HPP |
|
| 11 | ||
| 12 |
#include "../../../population_dynamics/population/population.hpp" |
|
| 13 |
#include "rcpp_interface_base.hpp" |
|
| 14 | ||
| 15 |
/** |
|
| 16 |
* @brief Rcpp interface that serves as the parent class for Rcpp population |
|
| 17 |
* interfaces. This type should be inherited and not called from R directly. |
|
| 18 |
*/ |
|
| 19 |
class PopulationInterfaceBase : public FIMSRcppInterfaceBase {
|
|
| 20 |
public: |
|
| 21 |
/** |
|
| 22 |
* @brief The static id of the PopulationInterfaceBase object. |
|
| 23 |
*/ |
|
| 24 |
static uint32_t id_g; |
|
| 25 |
/** |
|
| 26 |
* @brief The local id of the PopulationInterfaceBase object. |
|
| 27 |
*/ |
|
| 28 |
uint32_t id; |
|
| 29 |
/** |
|
| 30 |
* @brief The map associating the IDs of PopulationInterfaceBase to the objects. |
|
| 31 |
* This is a live object, which is an object that has been created and lives |
|
| 32 |
* in memory. |
|
| 33 |
*/ |
|
| 34 |
static std::map<uint32_t, PopulationInterfaceBase*> live_objects; |
|
| 35 | ||
| 36 |
/** |
|
| 37 |
* @brief The constructor. |
|
| 38 |
*/ |
|
| 39 | ! |
PopulationInterfaceBase() {
|
| 40 | ! |
this->id = PopulationInterfaceBase::id_g++; |
| 41 |
/* Create instance of map: key is id and value is pointer to |
|
| 42 |
PopulationInterfaceBase */ |
|
| 43 | ! |
PopulationInterfaceBase::live_objects[this->id] = this; |
| 44 | ! |
PopulationInterfaceBase::fims_interface_objects.push_back(this); |
| 45 |
} |
|
| 46 | ||
| 47 |
/** |
|
| 48 |
* @brief The destructor. |
|
| 49 |
*/ |
|
| 50 | ! |
virtual ~PopulationInterfaceBase() {}
|
| 51 | ||
| 52 |
/** |
|
| 53 |
* @brief Get the ID for the child population interface objects to inherit. |
|
| 54 |
*/ |
|
| 55 |
virtual uint32_t get_id() = 0; |
|
| 56 |
}; |
|
| 57 |
// static id of the PopulationInterfaceBase object |
|
| 58 |
uint32_t PopulationInterfaceBase::id_g = 1; |
|
| 59 |
// local id of the PopulationInterfaceBase object map relating the ID of the |
|
| 60 |
// PopulationInterfaceBase to the PopulationInterfaceBase objects |
|
| 61 |
std::map<uint32_t, PopulationInterfaceBase*> |
|
| 62 |
PopulationInterfaceBase::live_objects; |
|
| 63 | ||
| 64 |
/** |
|
| 65 |
* @brief Rcpp interface for a new Population to instantiate from R: |
|
| 66 |
* population <- methods::new(population) |
|
| 67 |
*/ |
|
| 68 |
class PopulationInterface : public PopulationInterfaceBase {
|
|
| 69 |
public: |
|
| 70 |
/** |
|
| 71 |
* @brief The number of age bins. |
|
| 72 |
*/ |
|
| 73 |
uint32_t nages; |
|
| 74 |
/** |
|
| 75 |
* @brief The number of fleets. |
|
| 76 |
*/ |
|
| 77 |
uint32_t nfleets; |
|
| 78 |
/** |
|
| 79 |
* @brief The number of seasons. |
|
| 80 |
* TODO: Remove seasons because we do not model them. |
|
| 81 |
*/ |
|
| 82 |
uint32_t nseasons; |
|
| 83 |
/** |
|
| 84 |
* @brief The number of years. |
|
| 85 |
*/ |
|
| 86 |
uint32_t nyears; |
|
| 87 |
/** |
|
| 88 |
* @brief The number of length bins. |
|
| 89 |
*/ |
|
| 90 |
uint32_t nlengths; |
|
| 91 |
/** |
|
| 92 |
* @brief The ID of the maturity module. |
|
| 93 |
*/ |
|
| 94 |
uint32_t maturity_id; |
|
| 95 |
/** |
|
| 96 |
* @brief The ID of the growth module. |
|
| 97 |
*/ |
|
| 98 |
uint32_t growth_id; |
|
| 99 |
/** |
|
| 100 |
* @brief The ID of the recruitment module. |
|
| 101 |
*/ |
|
| 102 |
uint32_t recruitment_id; |
|
| 103 |
/** |
|
| 104 |
* @brief The natural log of the natural mortality for each year. |
|
| 105 |
*/ |
|
| 106 |
ParameterVector log_M; |
|
| 107 |
/** |
|
| 108 |
* @brief The natural log of the initial numbers at age. |
|
| 109 |
*/ |
|
| 110 |
ParameterVector log_init_naa; |
|
| 111 |
/** |
|
| 112 |
* @brief Numbers at age. |
|
| 113 |
*/ |
|
| 114 |
ParameterVector numbers_at_age; |
|
| 115 |
/** |
|
| 116 |
* @brief Ages that are modeled in the population, the length of this vector |
|
| 117 |
* should equal \"nages\". |
|
| 118 |
*/ |
|
| 119 |
Rcpp::NumericVector ages; |
|
| 120 |
/** |
|
| 121 |
* @brief Derived spawning biomass. |
|
| 122 |
* TODO: This should be sb not ssb if left as an acronym. |
|
| 123 |
*/ |
|
| 124 |
Rcpp::NumericVector derived_ssb; |
|
| 125 |
/** |
|
| 126 |
* @brief Derived numbers at age. |
|
| 127 |
*/ |
|
| 128 |
Rcpp::NumericVector derived_naa; |
|
| 129 |
/** |
|
| 130 |
* @brief Derived biomass (mt). |
|
| 131 |
*/ |
|
| 132 |
Rcpp::NumericVector derived_biomass; |
|
| 133 |
/** |
|
| 134 |
* @brief Derived recruitment. |
|
| 135 |
* TODO: document the unit. |
|
| 136 |
*/ |
|
| 137 |
Rcpp::NumericVector derived_recruitment; |
|
| 138 |
/** |
|
| 139 |
* @brief Estimated natural log of mortality. |
|
| 140 |
*/ |
|
| 141 |
Rcpp::NumericVector estimated_log_M; |
|
| 142 |
/** |
|
| 143 |
* @brief Estimated natural log of initial numbers at age. |
|
| 144 |
*/ |
|
| 145 |
Rcpp::NumericVector estimated_log_init_naa; |
|
| 146 |
/** |
|
| 147 |
* @brief The name. |
|
| 148 |
* TODO: Document name better. |
|
| 149 |
*/ |
|
| 150 |
std::string name; |
|
| 151 | ||
| 152 |
/** |
|
| 153 |
* @brief The constructor. |
|
| 154 |
*/ |
|
| 155 | ! |
PopulationInterface() : PopulationInterfaceBase() {}
|
| 156 | ||
| 157 |
/** |
|
| 158 |
* @brief The destructor. |
|
| 159 |
*/ |
|
| 160 | ! |
virtual ~PopulationInterface() {}
|
| 161 | ||
| 162 |
/** |
|
| 163 |
* @brief Gets the ID of the interface base object. |
|
| 164 |
* @return The ID. |
|
| 165 |
*/ |
|
| 166 | ! |
virtual uint32_t get_id() { return this->id; }
|
| 167 | ||
| 168 |
/** |
|
| 169 |
* @brief Sets the unique ID for the Maturity object. |
|
| 170 |
* @param maturity_id Unique ID for the Maturity object. |
|
| 171 |
*/ |
|
| 172 | ! |
void SetMaturity(uint32_t maturity_id) { this->maturity_id = maturity_id; }
|
| 173 | ||
| 174 |
/** |
|
| 175 |
* @brief Set the unique ID for the growth object. |
|
| 176 |
* @param growth_id Unique ID for the growth object. |
|
| 177 |
*/ |
|
| 178 | ! |
void SetGrowth(uint32_t growth_id) { this->growth_id = growth_id; }
|
| 179 | ||
| 180 |
/** |
|
| 181 |
* @brief Set the unique ID for the recruitment object. |
|
| 182 |
* @param recruitment_id Unique ID for the recruitment object. |
|
| 183 |
*/ |
|
| 184 | ! |
void SetRecruitment(uint32_t recruitment_id) {
|
| 185 | ! |
this->recruitment_id = recruitment_id; |
| 186 |
} |
|
| 187 | ||
| 188 |
/** |
|
| 189 |
* @brief Evaluate the population function. |
|
| 190 |
*/ |
|
| 191 | ! |
virtual void evaluate() {
|
| 192 | ! |
fims_popdy::Population<double> population; |
| 193 | ! |
return population.Evaluate(); |
| 194 |
} |
|
| 195 | ||
| 196 |
/** |
|
| 197 |
* @brief Extracts derived quantities back to the Rcpp interface object from |
|
| 198 |
* the Information object. |
|
| 199 |
*/ |
|
| 200 | ! |
virtual void finalize() {
|
| 201 | ! |
if (this->finalized) {
|
| 202 |
//log warning that finalize has been called more than once. |
|
| 203 | ! |
FIMS_WARNING_LOG("Population " + fims::to_string(this->id) + " has been finalized already.");
|
| 204 |
} |
|
| 205 | ||
| 206 | ! |
this->finalized = true; //indicate this has been called already |
| 207 | ||
| 208 |
std::shared_ptr<fims_info::Information<double> > info = |
|
| 209 | ! |
fims_info::Information<double>::GetInstance(); |
| 210 | ||
| 211 | ! |
this->estimated_log_M = Rcpp::NumericVector(this->log_M.size()); |
| 212 | ! |
for (size_t i = 0; i < this->log_M.size(); i++) {
|
| 213 | ! |
this->estimated_log_M[i] = this->log_M[i].initial_value_m; |
| 214 |
} |
|
| 215 | ||
| 216 | ! |
this->estimated_log_init_naa = Rcpp::NumericVector(this->log_init_naa.size()); |
| 217 | ! |
for (size_t i = 0; i < this->log_init_naa.size(); i++) {
|
| 218 | ! |
this->estimated_log_init_naa[i] = this->log_init_naa[i].initial_value_m; |
| 219 |
} |
|
| 220 | ||
| 221 | ! |
fims_info::Information<double>::population_iterator it; |
| 222 | ||
| 223 | ! |
it = info->populations.find(this->id); |
| 224 | ||
| 225 |
std::shared_ptr<fims_popdy::Population<double> > pop = |
|
| 226 | ! |
info->populations[this->id]; |
| 227 | ! |
it = info->populations.find(this->id); |
| 228 | ! |
if (it == info->populations.end()) {
|
| 229 | ! |
FIMS_WARNING_LOG("Population " + fims::to_string(this->id) + " not found in Information.");
|
| 230 | ! |
return; |
| 231 |
} else {
|
|
| 232 | ! |
if (this->estimated_log_M) {
|
| 233 | ! |
for (size_t i = 0; i < this->log_M.size(); i++) {
|
| 234 | ! |
this->estimated_log_M[i] = pop->log_M[i]; |
| 235 |
} |
|
| 236 |
} |
|
| 237 | ||
| 238 | ! |
if (this->estimated_log_init_naa) {
|
| 239 | ! |
for (size_t i = 0; i < this->log_init_naa.size(); i++) {
|
| 240 | ! |
this->estimated_log_init_naa[i] = pop->log_init_naa[i]; |
| 241 |
} |
|
| 242 |
} |
|
| 243 | ||
| 244 | ! |
this->derived_naa = Rcpp::NumericVector(pop->numbers_at_age.size()); |
| 245 | ! |
this->derived_ssb = Rcpp::NumericVector(pop->spawning_biomass.size()); |
| 246 | ! |
this->derived_biomass = Rcpp::NumericVector(pop->biomass.size()); |
| 247 | ! |
this->derived_recruitment = Rcpp::NumericVector(pop->expected_recruitment.size()); |
| 248 | ||
| 249 |
//set naa from Information/ |
|
| 250 | ! |
for (R_xlen_t i = 0; i < this->derived_naa.size(); i++) {
|
| 251 | ! |
this->derived_naa[i] = pop->numbers_at_age[i]; |
| 252 |
} |
|
| 253 | ||
| 254 |
//set ssb from Information/ |
|
| 255 | ! |
for (R_xlen_t i = 0; i < this->derived_ssb.size(); i++) {
|
| 256 | ! |
this->derived_ssb[i] = pop->spawning_biomass[i]; |
| 257 |
} |
|
| 258 | ||
| 259 |
//set biomass from Information |
|
| 260 | ! |
for (R_xlen_t i = 0; i < this->derived_biomass.size(); i++) {
|
| 261 | ! |
this->derived_biomass[i] = pop->biomass[i]; |
| 262 |
} |
|
| 263 | ||
| 264 |
//set recruitment from Information/ |
|
| 265 | ! |
for (R_xlen_t i = 0; i < this->derived_recruitment.size(); i++) {
|
| 266 | ! |
this->derived_recruitment[i] = pop->expected_recruitment[i]; |
| 267 |
} |
|
| 268 | ||
| 269 |
} |
|
| 270 | ||
| 271 |
} |
|
| 272 | ||
| 273 |
/** |
|
| 274 |
* @brief Converts the data to json representation for the output. |
|
| 275 |
* @return A string is returned specifying that the module relates to the |
|
| 276 |
* population interface. It also returns the ID for each associated module |
|
| 277 |
* and the values associated with that module. Then it returns several |
|
| 278 |
* derived quantities. This string is formatted for a json file. |
|
| 279 |
*/ |
|
| 280 | ! |
virtual std::string to_json() {
|
| 281 | ! |
std::stringstream ss; |
| 282 | ||
| 283 | ! |
ss << "\"module\" : {\n";
|
| 284 | ! |
ss << " \"name\" : \"Population\",\n"; |
| 285 | ||
| 286 | ! |
ss << " \"type\" : \"population\",\n"; |
| 287 | ! |
ss << " \"tag\" : \"" << this->name << "\",\n"; |
| 288 | ! |
ss << " \"id\": " << this->id << ",\n"; |
| 289 | ! |
ss << " \"recruitment_id\": " << this->recruitment_id << ",\n"; |
| 290 | ! |
ss << " \"growth_id\": " << this->growth_id << ",\n"; |
| 291 | ! |
ss << " \"maturity_id\": " << this->maturity_id << ",\n"; |
| 292 | ||
| 293 | ! |
ss << " \"parameter\": {\n";
|
| 294 | ! |
ss << " \"name\": \"log_M\",\n"; |
| 295 | ! |
ss << " \"id\":" << -999 << ",\n"; |
| 296 | ! |
ss << " \"type\": \"vector\",\n"; |
| 297 | ! |
ss << " \"values\": " << this->log_M << "\n},\n"; |
| 298 | ||
| 299 | ! |
ss << " \"parameter\": {\n";
|
| 300 | ! |
ss << " \"name\": \"log_init_naa\",\n"; |
| 301 | ! |
ss << " \"id\":" << -999 << ",\n"; |
| 302 | ! |
ss << " \"type\": \"vector\",\n"; |
| 303 | ! |
ss << " \"values\":" << this->log_init_naa << " \n},\n"; |
| 304 | ||
| 305 | ! |
ss << " \"derived_quantity\": {\n";
|
| 306 | ! |
ss << " \"name\": \"ssb\",\n"; |
| 307 | ! |
ss << " \"values\":["; |
| 308 | ! |
if (this->derived_ssb.size() == 0) {
|
| 309 | ! |
ss << "]\n"; |
| 310 |
} else {
|
|
| 311 | ! |
for (R_xlen_t i = 0; i < this->derived_ssb.size() - 1; i++) {
|
| 312 | ! |
ss << this->derived_ssb[i] << ", "; |
| 313 |
} |
|
| 314 | ! |
ss << this->derived_ssb[this->derived_ssb.size() - 1] << "]\n"; |
| 315 |
} |
|
| 316 | ! |
ss << " },\n"; |
| 317 | ||
| 318 | ! |
ss << " \"derived_quantity\": {\n";
|
| 319 | ! |
ss << " \"name\": \"naa\",\n"; |
| 320 | ! |
ss << " \"values\":["; |
| 321 | ! |
if (this->derived_naa.size() == 0) {
|
| 322 | ! |
ss << "]\n"; |
| 323 |
} else {
|
|
| 324 | ! |
for (R_xlen_t i = 0; i < this->derived_naa.size() - 1; i++) {
|
| 325 | ! |
ss << this->derived_naa[i] << ", "; |
| 326 |
} |
|
| 327 | ! |
ss << this->derived_naa[this->derived_naa.size() - 1] << "]\n"; |
| 328 |
} |
|
| 329 | ! |
ss << " },\n"; |
| 330 | ||
| 331 | ! |
ss << " \"derived_quantity\": {\n";
|
| 332 | ! |
ss << " \"name\": \"biomass\",\n"; |
| 333 | ! |
ss << " \"values\":["; |
| 334 | ! |
if (this->derived_biomass.size() == 0) {
|
| 335 | ! |
ss << "]\n"; |
| 336 |
} else {
|
|
| 337 | ! |
for (R_xlen_t i = 0; i < this->derived_biomass.size() - 1; i++) {
|
| 338 | ! |
ss << this->derived_biomass[i] << ", "; |
| 339 |
} |
|
| 340 | ! |
ss << this->derived_biomass[this->derived_biomass.size() - 1] << "]\n"; |
| 341 |
} |
|
| 342 | ! |
ss << " },\n"; |
| 343 | ||
| 344 | ! |
ss << " \"derived_quantity\": {\n";
|
| 345 | ! |
ss << " \"name\": \"recruitment\",\n"; |
| 346 | ! |
ss << " \"values\":["; |
| 347 | ! |
if (this->derived_recruitment.size() == 0) {
|
| 348 | ! |
ss << "]\n"; |
| 349 |
} else {
|
|
| 350 | ! |
for (R_xlen_t i = 0; i < this->derived_recruitment.size() - 1; i++) {
|
| 351 | ! |
ss << this->derived_recruitment[i] << ", "; |
| 352 |
} |
|
| 353 | ! |
ss << this->derived_recruitment[this->derived_recruitment.size() - 1] << "]\n"; |
| 354 |
} |
|
| 355 | ! |
ss << " }\n"; |
| 356 | ||
| 357 | ! |
ss << "}"; |
| 358 | ||
| 359 | ! |
return ss.str(); |
| 360 |
} |
|
| 361 | ||
| 362 | ||
| 363 |
#ifdef TMB_MODEL |
|
| 364 | ||
| 365 |
template <typename Type> |
|
| 366 | ! |
bool add_to_fims_tmb_internal() {
|
| 367 |
std::shared_ptr<fims_info::Information<Type> > info = |
|
| 368 | ! |
fims_info::Information<Type>::GetInstance(); |
| 369 | ||
| 370 |
std::shared_ptr<fims_popdy::Population<Type> > population = |
|
| 371 | ! |
std::make_shared<fims_popdy::Population<Type> >(); |
| 372 | ||
| 373 |
// set relative info |
|
| 374 | ! |
population->id = this->id; |
| 375 | ! |
population->nyears = this->nyears; |
| 376 | ! |
population->nfleets = this->nfleets; |
| 377 | ! |
population->nseasons = this->nseasons; |
| 378 | ! |
population->nages = this->nages; |
| 379 | ! |
if (this->nages == this->ages.size()) {
|
| 380 | ! |
population->ages.resize(this->nages); |
| 381 |
} else {
|
|
| 382 | ! |
warning("The ages vector is not of size nages.");
|
| 383 |
} |
|
| 384 | ||
| 385 | ! |
population->growth_id = this->growth_id; |
| 386 | ! |
population->recruitment_id = this->recruitment_id; |
| 387 | ! |
population->maturity_id = this->maturity_id; |
| 388 | ! |
population->log_M.resize(this->log_M.size()); |
| 389 | ! |
population->log_init_naa.resize(this->log_init_naa.size()); |
| 390 | ! |
for (size_t i = 0; i < log_M.size(); i++) {
|
| 391 | ! |
population->log_M[i] = this->log_M[i].initial_value_m; |
| 392 | ! |
if (this->log_M[i].estimated_m) {
|
| 393 | ! |
info->RegisterParameterName("log_M");
|
| 394 | ! |
info->RegisterParameter(population->log_M[i]); |
| 395 |
} |
|
| 396 |
} |
|
| 397 | ! |
info->variable_map[this->log_M.id_m] = &(population)->log_M; |
| 398 | ||
| 399 | ! |
for (size_t i = 0; i < log_init_naa.size(); i++) {
|
| 400 | ! |
population->log_init_naa[i] = this->log_init_naa[i].initial_value_m; |
| 401 | ! |
if (this->log_init_naa[i].estimated_m) {
|
| 402 | ! |
info->RegisterParameterName("log_init_naa");
|
| 403 | ! |
info->RegisterParameter(population->log_init_naa[i]); |
| 404 |
} |
|
| 405 |
} |
|
| 406 | ! |
info->variable_map[this->log_init_naa.id_m] = &(population)->log_init_naa; |
| 407 | ! |
for (int i = 0; i < ages.size(); i++) {
|
| 408 | ! |
population->ages[i] = this->ages[i]; |
| 409 |
} |
|
| 410 | ||
| 411 | ! |
population->numbers_at_age.resize((nyears + 1) * nages); |
| 412 | ! |
info->variable_map[this->numbers_at_age.id_m] = &(population)->numbers_at_age; |
| 413 | ||
| 414 |
// add to Information |
|
| 415 | ! |
info->populations[population->id] = population; |
| 416 | ||
| 417 |
return true; |
|
| 418 |
} |
|
| 419 | ||
| 420 |
/** |
|
| 421 |
* @brief Adds the parameters to the TMB model. |
|
| 422 |
* @return A boolean of true. |
|
| 423 |
*/ |
|
| 424 | ! |
virtual bool add_to_fims_tmb() {
|
| 425 | ! |
FIMS_INFO_LOG("adding Population object to TMB");
|
| 426 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 427 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 428 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 429 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 430 | ||
| 431 | ! |
return true; |
| 432 |
} |
|
| 433 | ||
| 434 |
#endif |
|
| 435 |
}; |
|
| 436 | ||
| 437 |
#endif |
| 1 |
/** |
|
| 2 |
* @file rcpp_recruitment.hpp |
|
| 3 |
* @brief The Rcpp interface to declare different types of recruitment, e.g., |
|
| 4 |
* Beverton--Holt stock--recruitment relationship. Allows for the use of |
|
| 5 |
* methods::new() in R. |
|
| 6 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 7 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 8 |
* folder for reuse information. |
|
| 9 |
*/ |
|
| 10 |
#ifndef FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_RECRUITMENT_HPP |
|
| 11 |
#define FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_RECRUITMENT_HPP |
|
| 12 | ||
| 13 |
#include "../../../population_dynamics/recruitment/recruitment.hpp" |
|
| 14 |
#include "rcpp_interface_base.hpp" |
|
| 15 | ||
| 16 |
/** |
|
| 17 |
* @brief Rcpp interface that serves as the parent class for Rcpp recruitment |
|
| 18 |
* interfaces. This type should be inherited and not called from R directly. |
|
| 19 |
*/ |
|
| 20 |
class RecruitmentInterfaceBase : public FIMSRcppInterfaceBase {
|
|
| 21 |
public: |
|
| 22 |
/** |
|
| 23 |
* @brief The static id of the RecruitmentInterfaceBase object. |
|
| 24 |
*/ |
|
| 25 |
static uint32_t id_g; |
|
| 26 |
/** |
|
| 27 |
* @brief The local id of the RecruitmentInterfaceBase object. |
|
| 28 |
*/ |
|
| 29 |
uint32_t id; |
|
| 30 |
/** |
|
| 31 |
* @brief The map associating the IDs of RecruitmentInterfaceBase to the |
|
| 32 |
* objects. This is a live object, which is an object that has been created |
|
| 33 |
* and lives in memory. |
|
| 34 |
*/ |
|
| 35 |
static std::map<uint32_t, RecruitmentInterfaceBase*> live_objects; |
|
| 36 | ||
| 37 |
/** |
|
| 38 |
* @brief The constructor. |
|
| 39 |
*/ |
|
| 40 | ! |
RecruitmentInterfaceBase() {
|
| 41 | ! |
this->id = RecruitmentInterfaceBase::id_g++; |
| 42 |
/* Create instance of map: key is id and value is pointer to |
|
| 43 |
RecruitmentInterfaceBase */ |
|
| 44 | ! |
RecruitmentInterfaceBase::live_objects[this->id] = this; |
| 45 | ! |
FIMSRcppInterfaceBase::fims_interface_objects.push_back(this); |
| 46 |
} |
|
| 47 | ||
| 48 |
/** |
|
| 49 |
* @brief The destructor. |
|
| 50 |
*/ |
|
| 51 | ! |
virtual ~RecruitmentInterfaceBase() {}
|
| 52 | ||
| 53 |
/** |
|
| 54 |
* @brief Get the ID for the child recruitment interface objects to inherit. |
|
| 55 |
*/ |
|
| 56 |
virtual uint32_t get_id() = 0; |
|
| 57 | ||
| 58 |
/** |
|
| 59 |
* @brief A method for each child recruitment interface object to inherit so |
|
| 60 |
* each recruitment option can have an evaluate() function. |
|
| 61 |
*/ |
|
| 62 |
virtual double evaluate(double spawners, double ssbzero) = 0; |
|
| 63 |
}; |
|
| 64 |
// static id of the RecruitmentInterfaceBase object |
|
| 65 |
uint32_t RecruitmentInterfaceBase::id_g = 1; |
|
| 66 |
// local id of the RecruitmentInterfaceBase object map relating the ID of the |
|
| 67 |
// RecruitmentInterfaceBase to the RecruitmentInterfaceBase objects |
|
| 68 |
std::map<uint32_t, RecruitmentInterfaceBase*> |
|
| 69 |
RecruitmentInterfaceBase::live_objects; |
|
| 70 | ||
| 71 |
/** |
|
| 72 |
* @brief Rcpp interface for Beverton--Holt to instantiate from R: |
|
| 73 |
* beverton_holt <- methods::new(beverton_holt). |
|
| 74 |
*/ |
|
| 75 |
class BevertonHoltRecruitmentInterface : public RecruitmentInterfaceBase {
|
|
| 76 |
public: |
|
| 77 |
/** |
|
| 78 |
* @brief The logistic transformation of steepness (h; productivity of the |
|
| 79 |
* population), where the parameter is transformed to constrain it between |
|
| 80 |
* 0.2 and 1.0. |
|
| 81 |
*/ |
|
| 82 |
ParameterVector logit_steep; |
|
| 83 |
/** |
|
| 84 |
* @brief The natural log of recruitment at unfished biomass. |
|
| 85 |
*/ |
|
| 86 |
ParameterVector log_rzero; |
|
| 87 |
/** |
|
| 88 |
* @brief The natural log of recruitment deviations. |
|
| 89 |
*/ |
|
| 90 |
ParameterVector log_devs; |
|
| 91 |
/** |
|
| 92 |
* @brief Should the natural log of recruitment deviations be estimated? The |
|
| 93 |
* default is false. |
|
| 94 |
*/ |
|
| 95 | ! |
bool estimate_log_devs = false; |
| 96 |
/** |
|
| 97 |
* @brief The estimate of the logit transformation of steepness. |
|
| 98 |
*/ |
|
| 99 |
double estimated_logit_steep; |
|
| 100 |
/** |
|
| 101 |
* @brief The estimate of the natural log of recruitment at unfished biomass. |
|
| 102 |
*/ |
|
| 103 |
double estimated_log_rzero; |
|
| 104 |
/** |
|
| 105 |
* @brief The estimates of the natural log of recruitment deviations. |
|
| 106 |
*/ |
|
| 107 |
Rcpp::NumericVector estimated_log_devs; |
|
| 108 | ||
| 109 |
/** |
|
| 110 |
* @brief The constructor. |
|
| 111 |
*/ |
|
| 112 | ! |
BevertonHoltRecruitmentInterface() : RecruitmentInterfaceBase() {}
|
| 113 | ||
| 114 |
/** |
|
| 115 |
* @brief The destructor. |
|
| 116 |
*/ |
|
| 117 | ! |
virtual ~BevertonHoltRecruitmentInterface() {}
|
| 118 | ||
| 119 |
/** |
|
| 120 |
* @brief Gets the ID of the interface base object. |
|
| 121 |
* @return The ID. |
|
| 122 |
*/ |
|
| 123 | ! |
virtual uint32_t get_id() { return this->id; }
|
| 124 | ||
| 125 |
/** |
|
| 126 |
* @brief Evaluate recruitment using the Beverton--Holt stock--recruitment |
|
| 127 |
* relationship. |
|
| 128 |
* @param spawners Spawning biomass per time step. |
|
| 129 |
* @param ssbzero The biomass at unfished levels. |
|
| 130 |
* TODO: Change to sbzero if continuing to use acronyms. |
|
| 131 |
*/ |
|
| 132 | ! |
virtual double evaluate(double spawners, double ssbzero) {
|
| 133 | ! |
fims_popdy::SRBevertonHolt<double> BevHolt; |
| 134 | ! |
BevHolt.logit_steep.resize(1); |
| 135 | ! |
BevHolt.logit_steep[0] = this->logit_steep[0].initial_value_m; |
| 136 | ! |
if (this->logit_steep[0].initial_value_m == 1.0) {
|
| 137 | ! |
warning( |
| 138 |
"Steepness is subject to a logit transformation. " |
|
| 139 |
"Fixing it at 1.0 is not currently possible." |
|
| 140 |
); |
|
| 141 |
} |
|
| 142 | ! |
BevHolt.log_rzero.resize(1); |
| 143 | ! |
BevHolt.log_rzero[0] = this->log_rzero[0].initial_value_m; |
| 144 | ||
| 145 | ! |
return BevHolt.evaluate(spawners, ssbzero); |
| 146 |
} |
|
| 147 | ||
| 148 |
/** |
|
| 149 |
* @brief Extracts derived quantities back to the Rcpp interface object from |
|
| 150 |
* the Information object. |
|
| 151 |
*/ |
|
| 152 | ! |
virtual void finalize() {
|
| 153 | ! |
if (this->finalized) {
|
| 154 |
//log warning that finalize has been called more than once. |
|
| 155 | ! |
FIMS_WARNING_LOG("Beverton-Holt Recruitment " + fims::to_string(this->id) + " has been finalized already.");
|
| 156 |
} |
|
| 157 | ||
| 158 | ! |
this->finalized = true; //indicate this has been called already |
| 159 | ||
| 160 |
std::shared_ptr<fims_info::Information<double> > info = |
|
| 161 | ! |
fims_info::Information<double>::GetInstance(); |
| 162 | ||
| 163 | ! |
fims_info::Information<double>::recruitment_models_iterator it; |
| 164 | ||
| 165 | ! |
it = info->recruitment_models.find(this->id); |
| 166 | ||
| 167 | ! |
if (it == info->recruitment_models.end()) {
|
| 168 | ! |
FIMS_WARNING_LOG("Beverton-Holt Recruitment " + fims::to_string(this->id) + " not found in Information.");
|
| 169 | ! |
return; |
| 170 |
} else {
|
|
| 171 |
std::shared_ptr<fims_popdy::SRBevertonHolt<double> > recr = |
|
| 172 | ! |
std::dynamic_pointer_cast<fims_popdy::SRBevertonHolt<double> >(it->second); |
| 173 | ||
| 174 | ! |
for (size_t i = 0; i < this->logit_steep.size(); i++) {
|
| 175 | ! |
if (this->logit_steep[i].estimated_m) {
|
| 176 | ! |
this->logit_steep[i].final_value_m = recr->logit_steep[i]; |
| 177 |
} else {
|
|
| 178 | ! |
this->logit_steep[i].final_value_m = this->logit_steep[i].initial_value_m; |
| 179 |
} |
|
| 180 |
} |
|
| 181 | ||
| 182 | ! |
for (size_t i = 0; i < log_rzero.size(); i++) {
|
| 183 | ! |
if (log_rzero[i].estimated_m) {
|
| 184 | ! |
this->log_rzero[i].final_value_m = recr->log_rzero[i]; |
| 185 |
} else {
|
|
| 186 | ! |
this->log_rzero[i].final_value_m = this->log_rzero[i].initial_value_m; |
| 187 |
} |
|
| 188 |
} |
|
| 189 | ||
| 190 | ! |
for (R_xlen_t i = 0; i < this->estimated_log_devs.size(); i++) {
|
| 191 | ! |
if (this->log_devs[i].estimated_m) {
|
| 192 | ! |
this->log_devs[i].final_value_m = recr->log_recruit_devs[i]; |
| 193 |
} else {
|
|
| 194 | ! |
this->log_devs[i].final_value_m = this->log_devs[i].initial_value_m; |
| 195 |
} |
|
| 196 |
} |
|
| 197 |
} |
|
| 198 |
} |
|
| 199 | ||
| 200 |
/** |
|
| 201 |
* @brief Converts the data to json representation for the output. |
|
| 202 |
* @return A string is returned specifying that the module relates to the |
|
| 203 |
* recruitment interface with Beverton--Holt stock--recruitment relationship. |
|
| 204 |
* It also returns the ID and the parameters. This string is formatted for a |
|
| 205 |
* json file. |
|
| 206 |
*/ |
|
| 207 | ! |
virtual std::string to_json() {
|
| 208 | ! |
std::stringstream ss; |
| 209 | ||
| 210 | ! |
ss << "\"module\" : {\n";
|
| 211 | ! |
ss << " \"name\": \"recruitment\",\n"; |
| 212 | ! |
ss << " \"type\": \"Beverton--Holt\",\n"; |
| 213 | ! |
ss << " \"id\": " << this->id << ",\n"; |
| 214 | ||
| 215 | ! |
ss << " \"parameter\": {\n";
|
| 216 | ! |
ss << " \"name\": \"logit_steep\",\n"; |
| 217 | ! |
ss << " \"id\":" << this->logit_steep.id_m << ",\n"; |
| 218 | ! |
ss << " \"type\": \"vector\",\n"; |
| 219 | ! |
ss << " \"values\":" << this->logit_steep << ",\n},\n"; |
| 220 | ||
| 221 | ! |
ss << " \"parameter\": {\n";
|
| 222 | ! |
ss << " \"name\": \"log_rzero\",\n"; |
| 223 | ! |
ss << " \"id\":" << this->log_rzero.id_m << ",\n"; |
| 224 | ! |
ss << " \"type\": \"vector\",\n"; |
| 225 | ! |
ss << " \"values\":" << this->log_rzero << ",\n },\n"; |
| 226 | ||
| 227 | ! |
ss << " \"parameter\": {\n";
|
| 228 | ! |
ss << " \"name\": \"log_devs\",\n"; |
| 229 | ! |
ss << " \"id\":" << this->log_devs.id_m << ",\n"; |
| 230 | ! |
ss << " \"type\": \"vector\",\n"; |
| 231 | ! |
ss << " \"values\":" << this->log_devs << ",\n },\n"; |
| 232 | ||
| 233 | ! |
return ss.str(); |
| 234 |
} |
|
| 235 | ||
| 236 |
#ifdef TMB_MODEL |
|
| 237 | ||
| 238 |
template <typename Type> |
|
| 239 | ! |
bool add_to_fims_tmb_internal() {
|
| 240 |
std::shared_ptr<fims_info::Information<Type> > info = |
|
| 241 | ! |
fims_info::Information<Type>::GetInstance(); |
| 242 | ||
| 243 |
std::shared_ptr<fims_popdy::SRBevertonHolt<Type> > recruitment = |
|
| 244 | ! |
std::make_shared<fims_popdy::SRBevertonHolt<Type> >(); |
| 245 | ||
| 246 |
// set relative info |
|
| 247 | ! |
recruitment->id = this->id; |
| 248 |
//set logit_steep |
|
| 249 | ! |
recruitment->logit_steep.resize(this->logit_steep.size()); |
| 250 | ! |
for (size_t i = 0; i < this->logit_steep.size(); i++) {
|
| 251 | ! |
recruitment->logit_steep[i] = this->logit_steep[i].initial_value_m; |
| 252 | ||
| 253 | ! |
if (this->logit_steep[i].estimated_m) {
|
| 254 | ! |
info->RegisterParameterName("logit_steep");
|
| 255 | ! |
if (this->logit_steep[i].is_random_effect_m) {
|
| 256 | ! |
info->RegisterRandomEffect(recruitment->logit_steep[i]); |
| 257 |
} else {
|
|
| 258 | ! |
info->RegisterParameter(recruitment->logit_steep[i]); |
| 259 |
} |
|
| 260 |
} |
|
| 261 | ||
| 262 |
} |
|
| 263 | ||
| 264 | ! |
info->variable_map[this->logit_steep.id_m] = &(recruitment)->logit_steep; |
| 265 | ||
| 266 |
//set log_rzero |
|
| 267 | ! |
recruitment->log_rzero.resize(this->log_rzero.size()); |
| 268 | ! |
for (size_t i = 0; i < this->log_rzero.size(); i++) {
|
| 269 | ! |
recruitment->log_rzero[i] = this->log_rzero[i].initial_value_m; |
| 270 | ||
| 271 | ! |
if (this->log_rzero[i].estimated_m) {
|
| 272 | ! |
info->RegisterParameterName("log_rzero");
|
| 273 | ! |
if (this->log_rzero[i].is_random_effect_m) {
|
| 274 | ! |
info->RegisterRandomEffect(recruitment->log_rzero[i]); |
| 275 |
} else {
|
|
| 276 | ! |
info->RegisterParameter(recruitment->log_rzero[i]); |
| 277 |
} |
|
| 278 |
} |
|
| 279 |
} |
|
| 280 | ||
| 281 | ! |
info->variable_map[this->log_rzero.id_m] = &(recruitment)->log_rzero; |
| 282 | ||
| 283 |
//set log_recruit_devs |
|
| 284 | ! |
recruitment->log_recruit_devs.resize(this->log_devs.size()); |
| 285 | ! |
for (size_t i = 0; i < this->log_devs.size(); i++) {
|
| 286 | ! |
recruitment->log_recruit_devs[i] = this->log_devs[i].initial_value_m; |
| 287 | ! |
if (this->log_devs[i].estimated_m) {
|
| 288 | ! |
info->RegisterParameter(recruitment->log_recruit_devs[i]); |
| 289 |
} else {
|
|
| 290 | ! |
recruitment->estimate_log_recruit_devs = false; |
| 291 |
} |
|
| 292 |
} |
|
| 293 | ! |
info->variable_map[this->log_devs.id_m] = &(recruitment)->log_recruit_devs; |
| 294 | ||
| 295 |
// add to Information |
|
| 296 | ! |
info->recruitment_models[recruitment->id] = recruitment; |
| 297 | ||
| 298 |
return true; |
|
| 299 |
} |
|
| 300 | ||
| 301 |
/** |
|
| 302 |
* @brief Adds the parameters to the TMB model. |
|
| 303 |
* @return A boolean of true. |
|
| 304 |
*/ |
|
| 305 | ! |
virtual bool add_to_fims_tmb() {
|
| 306 | ! |
FIMS_INFO_LOG("adding Recruitment object to TMB");
|
| 307 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 308 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 309 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 310 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 311 | ||
| 312 | ! |
return true; |
| 313 |
} |
|
| 314 | ||
| 315 |
#endif |
|
| 316 |
}; |
|
| 317 | ||
| 318 |
#endif |
| 1 |
/** |
|
| 2 |
* @file rcpp_selectivity.hpp |
|
| 3 |
* @brief The Rcpp interface to declare different types of selectivity, e.g., |
|
| 4 |
* logistic and double logistic. Allows for the use of methods::new() in R. |
|
| 5 |
* @copyright This file is part of the NOAA, National Marine Fisheries Service |
|
| 6 |
* Fisheries Integrated Modeling System project. See LICENSE in the source |
|
| 7 |
* folder for reuse information. |
|
| 8 |
*/ |
|
| 9 |
#ifndef FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_SELECTIVITY_HPP |
|
| 10 |
#define FIMS_INTERFACE_RCPP_RCPP_OBJECTS_RCPP_SELECTIVITY_HPP |
|
| 11 | ||
| 12 |
#include "../../../population_dynamics/selectivity/selectivity.hpp" |
|
| 13 |
#include "rcpp_interface_base.hpp" |
|
| 14 | ||
| 15 |
/** |
|
| 16 |
* @brief Rcpp interface that serves as the parent class for Rcpp selectivity |
|
| 17 |
* interfaces. This type should be inherited and not called from R directly. |
|
| 18 |
*/ |
|
| 19 |
class SelectivityInterfaceBase : public FIMSRcppInterfaceBase {
|
|
| 20 |
public: |
|
| 21 |
/** |
|
| 22 |
* @brief The static id of the SelectivityInterfaceBase. |
|
| 23 |
*/ |
|
| 24 |
static uint32_t id_g; |
|
| 25 |
/** |
|
| 26 |
* @brief The local id of the SelectivityInterfaceBase object. |
|
| 27 |
*/ |
|
| 28 |
uint32_t id; |
|
| 29 |
/** |
|
| 30 |
* @brief The map associating the IDs of SelectivityInterfaceBase to the |
|
| 31 |
* objects. This is a live object, which is an object that has been created |
|
| 32 |
* and lives in memory. |
|
| 33 |
*/ |
|
| 34 |
static std::map<uint32_t, SelectivityInterfaceBase*> live_objects; |
|
| 35 | ||
| 36 |
/** |
|
| 37 |
* @brief The constructor. |
|
| 38 |
*/ |
|
| 39 | ! |
SelectivityInterfaceBase() {
|
| 40 | ! |
this->id = SelectivityInterfaceBase::id_g++; |
| 41 |
/* Create instance of map: key is id and value is pointer to |
|
| 42 |
SelectivityInterfaceBase */ |
|
| 43 | ! |
SelectivityInterfaceBase::live_objects[this->id] = this; |
| 44 | ! |
FIMSRcppInterfaceBase::fims_interface_objects.push_back(this); |
| 45 |
} |
|
| 46 | ||
| 47 |
/** |
|
| 48 |
* @brief The destructor. |
|
| 49 |
*/ |
|
| 50 | ! |
virtual ~SelectivityInterfaceBase() {}
|
| 51 | ||
| 52 |
/** |
|
| 53 |
* @brief Get the ID for the child selectivity interface objects to inherit. |
|
| 54 |
*/ |
|
| 55 |
virtual uint32_t get_id() = 0; |
|
| 56 | ||
| 57 |
/** |
|
| 58 |
* @brief A method for each child selectivity interface object to inherit so |
|
| 59 |
* each selectivity option can have an evaluate() function. |
|
| 60 |
*/ |
|
| 61 |
virtual double evaluate(double x) = 0; |
|
| 62 |
}; |
|
| 63 |
// static id of the SelectivityInterfaceBase object |
|
| 64 |
uint32_t SelectivityInterfaceBase::id_g = 1; |
|
| 65 |
// local id of the SelectivityInterfaceBase object map relating the ID of the |
|
| 66 |
// SelectivityInterfaceBase to the SelectivityInterfaceBase objects |
|
| 67 |
std::map<uint32_t, SelectivityInterfaceBase*> |
|
| 68 |
SelectivityInterfaceBase::live_objects; |
|
| 69 | ||
| 70 |
/** |
|
| 71 |
* @brief Rcpp interface for logistic selectivity to instantiate the object |
|
| 72 |
* from R: |
|
| 73 |
* logistic_selectivity <- methods::new(logistic_selectivity). |
|
| 74 |
*/ |
|
| 75 |
class LogisticSelectivityInterface : public SelectivityInterfaceBase {
|
|
| 76 |
public: |
|
| 77 |
/** |
|
| 78 |
* @brief The index value at which the response reaches 0.5. |
|
| 79 |
*/ |
|
| 80 |
ParameterVector inflection_point; |
|
| 81 |
/** |
|
| 82 |
* @brief The width of the curve at the inflection point. |
|
| 83 |
*/ |
|
| 84 |
ParameterVector slope; |
|
| 85 | ||
| 86 |
/** |
|
| 87 |
* @brief The constructor. |
|
| 88 |
*/ |
|
| 89 | ! |
LogisticSelectivityInterface() : SelectivityInterfaceBase() {}
|
| 90 | ||
| 91 |
/** |
|
| 92 |
* @brief The destructor. |
|
| 93 |
*/ |
|
| 94 | ! |
virtual ~LogisticSelectivityInterface() {}
|
| 95 | ||
| 96 |
/** |
|
| 97 |
* @brief Gets the ID of the interface base object. |
|
| 98 |
* @return The ID. |
|
| 99 |
*/ |
|
| 100 | ! |
virtual uint32_t get_id() { return this->id; }
|
| 101 | ||
| 102 |
/** |
|
| 103 |
* @brief Evaluate selectivity using the logistic function. |
|
| 104 |
* @param x The independent variable in the logistic function (e.g., age or |
|
| 105 |
* size in selectivity). |
|
| 106 |
*/ |
|
| 107 | ! |
virtual double evaluate(double x) {
|
| 108 | ! |
fims_popdy::LogisticSelectivity<double> LogisticSel; |
| 109 | ! |
LogisticSel.inflection_point.resize(1); |
| 110 | ! |
LogisticSel.inflection_point[0] = this->inflection_point[0].initial_value_m; |
| 111 | ! |
LogisticSel.slope.resize(1); |
| 112 | ! |
LogisticSel.slope[0] = this->slope[0].initial_value_m; |
| 113 | ! |
return LogisticSel.evaluate(x); |
| 114 |
} |
|
| 115 | ||
| 116 |
/** |
|
| 117 |
* @brief Extracts derived quantities back to the Rcpp interface object from |
|
| 118 |
* the Information object. |
|
| 119 |
*/ |
|
| 120 | ! |
virtual void finalize() {
|
| 121 | ! |
if (this->finalized) {
|
| 122 |
//log warning that finalize has been called more than once. |
|
| 123 | ! |
FIMS_WARNING_LOG("Logistic Selectivity " + fims::to_string(this->id) + " has been finalized already.");
|
| 124 |
} |
|
| 125 | ||
| 126 | ! |
this->finalized = true; //indicate this has been called already |
| 127 | ||
| 128 |
std::shared_ptr<fims_info::Information<double> > info = |
|
| 129 | ! |
fims_info::Information<double>::GetInstance(); |
| 130 | ||
| 131 | ! |
fims_info::Information<double>::selectivity_models_iterator it; |
| 132 | ||
| 133 |
//search for maturity in Information |
|
| 134 | ! |
it = info->selectivity_models.find(this->id); |
| 135 |
//if not found, just return |
|
| 136 | ! |
if (it == info->selectivity_models.end()) {
|
| 137 | ! |
FIMS_WARNING_LOG("Logistic Selectivity " + fims::to_string(this->id) + " not found in Information.");
|
| 138 | ! |
return; |
| 139 |
} else {
|
|
| 140 |
std::shared_ptr<fims_popdy::LogisticSelectivity<double> > sel = |
|
| 141 | ! |
std::dynamic_pointer_cast<fims_popdy::LogisticSelectivity<double> >(it->second); |
| 142 | ||
| 143 | ! |
for (size_t i = 0; i < inflection_point.size(); i++) {
|
| 144 | ! |
if (this->inflection_point[i].estimated_m) {
|
| 145 | ! |
this->inflection_point[i].final_value_m = sel->inflection_point[i]; |
| 146 |
} else {
|
|
| 147 | ! |
this->inflection_point[i].final_value_m = this->inflection_point[i].initial_value_m; |
| 148 |
} |
|
| 149 |
} |
|
| 150 | ||
| 151 | ! |
for (size_t i = 0; i < slope.size(); i++) {
|
| 152 | ! |
if (this->slope[i].estimated_m) {
|
| 153 | ! |
this->slope[i].final_value_m = sel->slope[i]; |
| 154 |
} else {
|
|
| 155 | ! |
this->slope[i].final_value_m = this->slope[i].initial_value_m; |
| 156 |
} |
|
| 157 |
} |
|
| 158 |
} |
|
| 159 |
} |
|
| 160 | ||
| 161 |
/** |
|
| 162 |
* @brief Converts the data to json representation for the output. |
|
| 163 |
* @return A string is returned specifying that the module relates to the |
|
| 164 |
* selectivity interface with logistic selectivity. It also returns the ID |
|
| 165 |
* and the parameters. This string is formatted for a json file. |
|
| 166 |
*/ |
|
| 167 | ! |
virtual std::string to_json() {
|
| 168 | ! |
std::stringstream ss; |
| 169 | ||
| 170 | ! |
ss << "\"module\" : {\n";
|
| 171 | ! |
ss << " \"name\":\"selectivity\",\n"; |
| 172 | ! |
ss << " \"type\": \"Logistic\",\n"; |
| 173 | ! |
ss << " \"id\": " << this->id << ",\n"; |
| 174 | ||
| 175 | ! |
ss << " \"parameter\": {\n";
|
| 176 | ! |
ss << " \"name\": \"inflection_point\",\n"; |
| 177 | ! |
ss << " \"id\":" << this->inflection_point.id_m << ",\n"; |
| 178 | ! |
ss << " \"type\": \"vector\",\n"; |
| 179 | ! |
ss << " \"values\":" << this->inflection_point << ",\n },\n"; |
| 180 | ||
| 181 | ! |
ss << " \"parameter\": {\n";
|
| 182 | ! |
ss << " \"name\": \"slope\",\n"; |
| 183 | ! |
ss << " \"id\":" << this->slope.id_m << ",\n"; |
| 184 | ! |
ss << " \"type\": \"vector\",\n"; |
| 185 | ! |
ss << " \"values\":" << this->slope << ",\n}\n"; |
| 186 | ||
| 187 | ! |
ss << "}"; |
| 188 | ||
| 189 | ! |
return ss.str(); |
| 190 |
} |
|
| 191 | ||
| 192 | ||
| 193 |
#ifdef TMB_MODEL |
|
| 194 | ||
| 195 |
template <typename Type> |
|
| 196 | ! |
bool add_to_fims_tmb_internal() {
|
| 197 |
std::shared_ptr<fims_info::Information<Type> > info = |
|
| 198 | ! |
fims_info::Information<Type>::GetInstance(); |
| 199 | ||
| 200 |
std::shared_ptr<fims_popdy::LogisticSelectivity<Type> > selectivity = |
|
| 201 | ! |
std::make_shared<fims_popdy::LogisticSelectivity<Type> >(); |
| 202 | ! |
std::stringstream ss; |
| 203 |
// set relative info |
|
| 204 | ! |
selectivity->id = this->id; |
| 205 | ! |
selectivity->inflection_point.resize(this->inflection_point.size()); |
| 206 | ! |
for (size_t i = 0; i < this->inflection_point.size(); i++) {
|
| 207 | ! |
selectivity->inflection_point[i] = this->inflection_point[i].initial_value_m; |
| 208 | ! |
if (this->inflection_point[i].estimated_m) {
|
| 209 | ! |
ss.str("");
|
| 210 | ! |
ss << "selectivity.inflection_point." << this->id << "." << i; |
| 211 | ! |
info->RegisterParameterName(ss.str()); |
| 212 | ! |
if (this->inflection_point[i].is_random_effect_m) {
|
| 213 | ! |
info->RegisterRandomEffect(selectivity->inflection_point[i]); |
| 214 |
} else {
|
|
| 215 | ! |
info->RegisterParameter(selectivity->inflection_point[i]); |
| 216 |
} |
|
| 217 |
} |
|
| 218 |
} |
|
| 219 | ||
| 220 | ! |
info->variable_map[this->inflection_point.id_m] = &(selectivity)->inflection_point; |
| 221 | ! |
selectivity->slope.resize(this->slope.size()); |
| 222 | ! |
for (size_t i = 0; i < this->slope.size(); i++) {
|
| 223 | ! |
selectivity->slope[i] = this->slope[i].initial_value_m; |
| 224 | ! |
if (this->slope[i].estimated_m) {
|
| 225 | ! |
ss.str("");
|
| 226 | ! |
ss << "selectivity.slope." << this->id << "." << i; |
| 227 | ! |
info->RegisterParameterName(ss.str()); |
| 228 | ! |
if (this->slope[i].is_random_effect_m) {
|
| 229 | ! |
info->RegisterRandomEffect(selectivity->slope[i]); |
| 230 |
} else {
|
|
| 231 | ! |
info->RegisterParameter(selectivity->slope[i]); |
| 232 |
} |
|
| 233 |
} |
|
| 234 |
} |
|
| 235 | ! |
info->variable_map[this->slope.id_m] = &(selectivity)->slope; |
| 236 | ||
| 237 |
// add to Information |
|
| 238 | ! |
info->selectivity_models[selectivity->id] = selectivity; |
| 239 | ||
| 240 |
return true; |
|
| 241 |
} |
|
| 242 | ||
| 243 |
/** |
|
| 244 |
* @brief Adds the parameters to the TMB model. |
|
| 245 |
* @return A boolean of true. |
|
| 246 |
*/ |
|
| 247 | ! |
virtual bool add_to_fims_tmb() {
|
| 248 | ! |
FIMS_INFO_LOG("adding Selectivity object to TMB");
|
| 249 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 250 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 251 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 252 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 253 | ||
| 254 | ! |
return true; |
| 255 |
} |
|
| 256 | ||
| 257 |
#endif |
|
| 258 |
}; |
|
| 259 | ||
| 260 |
/** |
|
| 261 |
* @brief Rcpp interface for logistic selectivity as an S4 object. To |
|
| 262 |
* instantiate from R: logistic_selectivity <- methods::new(logistic_selectivity) |
|
| 263 |
*/ |
|
| 264 |
class DoubleLogisticSelectivityInterface : public SelectivityInterfaceBase {
|
|
| 265 |
public: |
|
| 266 |
ParameterVector inflection_point_asc; /**< the index value at which the response |
|
| 267 |
reaches .5 */ |
|
| 268 |
ParameterVector slope_asc; /**< the width of the curve at the inflection_point */ |
|
| 269 |
ParameterVector inflection_point_desc; /**< the index value at which the response |
|
| 270 |
reaches .5 */ |
|
| 271 |
ParameterVector slope_desc; /**< the width of the curve at the inflection_point */ |
|
| 272 | ||
| 273 | ||
| 274 | ! |
DoubleLogisticSelectivityInterface() : SelectivityInterfaceBase() {}
|
| 275 | ||
| 276 | ! |
virtual ~DoubleLogisticSelectivityInterface() {}
|
| 277 | ||
| 278 |
/** @brief returns the id for the double logistic selectivity interface */ |
|
| 279 | ! |
virtual uint32_t get_id() { return this->id; }
|
| 280 | ||
| 281 |
/** @brief evaluate the double logistic selectivity function |
|
| 282 |
* @param x The independent variable in the logistic function (e.g., age or |
|
| 283 |
* size in selectivity). |
|
| 284 |
*/ |
|
| 285 | ! |
virtual double evaluate(double x) {
|
| 286 | ! |
fims_popdy::DoubleLogisticSelectivity<double> DoubleLogisticSel; |
| 287 | ! |
DoubleLogisticSel.inflection_point_asc.resize(1); |
| 288 | ! |
DoubleLogisticSel.inflection_point_asc[0] = this->inflection_point_asc[0].initial_value_m; |
| 289 | ! |
DoubleLogisticSel.slope_asc.resize(1); |
| 290 | ! |
DoubleLogisticSel.slope_asc[0] = this->slope_asc[0].initial_value_m; |
| 291 | ! |
DoubleLogisticSel.inflection_point_desc.resize(1); |
| 292 | ! |
DoubleLogisticSel.inflection_point_desc[0] = |
| 293 | ! |
this->inflection_point_desc[0].initial_value_m; |
| 294 | ! |
DoubleLogisticSel.slope_desc.resize(1); |
| 295 | ! |
DoubleLogisticSel.slope_desc[0] = this->slope_desc[0].initial_value_m; |
| 296 | ! |
return DoubleLogisticSel.evaluate(x); |
| 297 |
} |
|
| 298 |
/** |
|
| 299 |
* @brief finalize function. Extracts derived quantities back to |
|
| 300 |
* the Rcpp interface object from the Information object. |
|
| 301 |
*/ |
|
| 302 | ! |
virtual void finalize() {
|
| 303 | ||
| 304 | ! |
if (this->finalized) {
|
| 305 |
//log warning that finalize has been called more than once. |
|
| 306 | ! |
FIMS_WARNING_LOG("Double Logistic Selectivity " + fims::to_string(this->id) + " has been finalized already.");
|
| 307 |
} |
|
| 308 | ||
| 309 | ! |
this->finalized = true; //indicate this has been called already |
| 310 | ||
| 311 |
std::shared_ptr<fims_info::Information<double> > info = |
|
| 312 | ! |
fims_info::Information<double>::GetInstance(); |
| 313 | ||
| 314 | ||
| 315 | ||
| 316 | ! |
fims_info::Information<double>::selectivity_models_iterator it; |
| 317 | ||
| 318 |
//search for maturity in Information |
|
| 319 | ! |
it = info->selectivity_models.find(this->id); |
| 320 |
//if not found, just return |
|
| 321 | ! |
if (it == info->selectivity_models.end()) {
|
| 322 | ! |
FIMS_WARNING_LOG("Double Logistic Selectivity " + fims::to_string(this->id) + " not found in Information.");
|
| 323 | ! |
return; |
| 324 |
} else {
|
|
| 325 |
std::shared_ptr<fims_popdy::DoubleLogisticSelectivity<double> > sel = |
|
| 326 | ! |
std::dynamic_pointer_cast<fims_popdy::DoubleLogisticSelectivity<double> >(it->second); |
| 327 | ||
| 328 | ||
| 329 | ! |
for (size_t i = 0; i < inflection_point_asc.size(); i++) {
|
| 330 | ! |
if (this->inflection_point_asc[i].estimated_m) {
|
| 331 | ! |
this->inflection_point_asc[i].final_value_m = sel->inflection_point_asc[i]; |
| 332 |
} else {
|
|
| 333 | ! |
this->inflection_point_asc[i].final_value_m = this->inflection_point_asc[i].initial_value_m; |
| 334 |
} |
|
| 335 | ||
| 336 |
} |
|
| 337 | ||
| 338 | ! |
for (size_t i = 0; i < slope_asc.size(); i++) {
|
| 339 | ! |
if (this->slope_asc[i].estimated_m) {
|
| 340 | ! |
this->slope_asc[i].final_value_m = sel->slope_asc[i]; |
| 341 |
} else {
|
|
| 342 | ! |
this->slope_asc[i].final_value_m = this->slope_asc[i].initial_value_m; |
| 343 |
} |
|
| 344 | ||
| 345 |
} |
|
| 346 | ||
| 347 | ! |
for (size_t i = 0; i < inflection_point_desc.size(); i++) {
|
| 348 | ! |
if (this->inflection_point_desc[i].estimated_m) {
|
| 349 | ! |
this->inflection_point_desc[i].final_value_m = sel->inflection_point_desc[i]; |
| 350 |
} else {
|
|
| 351 | ! |
this->inflection_point_desc[i].final_value_m = this->inflection_point_desc[i].initial_value_m; |
| 352 |
} |
|
| 353 | ||
| 354 |
} |
|
| 355 | ||
| 356 | ! |
for (size_t i = 0; i < slope_desc.size(); i++) {
|
| 357 | ! |
if (this->slope_desc[i].estimated_m) {
|
| 358 | ! |
this->slope_desc[i].final_value_m = sel->slope_desc[i]; |
| 359 |
} else {
|
|
| 360 | ! |
this->slope_desc[i].final_value_m = this->slope_desc[i].initial_value_m; |
| 361 |
} |
|
| 362 | ||
| 363 |
} |
|
| 364 | ||
| 365 | ||
| 366 | ||
| 367 |
} |
|
| 368 |
} |
|
| 369 | ||
| 370 |
/** |
|
| 371 |
* @brief Convert the data to json representation for the output. |
|
| 372 |
*/ |
|
| 373 | ! |
virtual std::string to_json() {
|
| 374 | ! |
std::stringstream ss; |
| 375 | ||
| 376 | ! |
ss << "\"module\" : {\n";
|
| 377 | ! |
ss << " \"name\": \"selectivity\",\n"; |
| 378 | ! |
ss << " \"type\": \"DoubleLogistic\",\n"; |
| 379 | ! |
ss << " \"id\": " << this->id << ",\n"; |
| 380 | ||
| 381 | ! |
ss << " \"parameter\": {\n";
|
| 382 | ! |
ss << " \"name\": \"inflection_point_asc\",\n"; |
| 383 | ! |
ss << " \"id\":" << this->inflection_point_asc.id_m << ",\n"; |
| 384 | ! |
ss << " \"type\": \"vector\",\n"; |
| 385 | ! |
ss << " \"values\":" << this->inflection_point_asc << ",\n},\n"; |
| 386 | ||
| 387 | ! |
ss << " \"parameter\": {\n";
|
| 388 | ! |
ss << " \"name\": \"slope_asc\",\n"; |
| 389 | ! |
ss << " \"id\":" << this->slope_asc.id_m << ",\n"; |
| 390 | ! |
ss << " \"type\": \"vector\",\n"; |
| 391 | ! |
ss << " \"values\":" << this->slope_asc << ",\n},\n"; |
| 392 | ||
| 393 | ! |
ss << " \"parameter\": {\n";
|
| 394 | ! |
ss << " \"name\": \"inflection_point_desc\",\n"; |
| 395 | ! |
ss << " \"id\":" << this->inflection_point_desc.id_m << ",\n"; |
| 396 | ! |
ss << " \"type\": \"vector\",\n"; |
| 397 | ! |
ss << " \"values\":" << this->inflection_point_desc << ",\n},\n"; |
| 398 | ||
| 399 | ! |
ss << " \"parameter\": {\n";
|
| 400 | ! |
ss << " \"name\": \"slope_desc\",\n"; |
| 401 | ! |
ss << " \"id\":" << this->slope_desc.id_m << ",\n"; |
| 402 | ! |
ss << " \"type\": \"vector\",\n"; |
| 403 | ! |
ss << " \"values\":" << this->slope_desc << ",\n}\n"; |
| 404 | ||
| 405 | ||
| 406 | ! |
ss << "}"; |
| 407 | ||
| 408 | ! |
return ss.str(); |
| 409 |
} |
|
| 410 | ||
| 411 | ||
| 412 |
#ifdef TMB_MODEL |
|
| 413 | ||
| 414 |
template <typename Type> |
|
| 415 | ! |
bool add_to_fims_tmb_internal() {
|
| 416 |
std::shared_ptr<fims_info::Information<Type> > info = |
|
| 417 | ! |
fims_info::Information<Type>::GetInstance(); |
| 418 | ||
| 419 |
std::shared_ptr<fims_popdy::DoubleLogisticSelectivity<Type> > selectivity = |
|
| 420 | ! |
std::make_shared<fims_popdy::DoubleLogisticSelectivity<Type> >(); |
| 421 | ||
| 422 | ! |
std::stringstream ss; |
| 423 |
// set relative info |
|
| 424 | ! |
selectivity->id = this->id; |
| 425 | ! |
selectivity->inflection_point_asc.resize(this->inflection_point_asc.size()); |
| 426 | ! |
for (size_t i = 0; i < this->inflection_point_asc.size(); i++) {
|
| 427 | ! |
selectivity->inflection_point_asc[i] = this->inflection_point_asc[i].initial_value_m; |
| 428 | ! |
if (this->inflection_point_asc[i].estimated_m) {
|
| 429 | ! |
ss.str("");
|
| 430 | ! |
ss << "selectivity.inflection_point_asc." << this->id << "." << i; |
| 431 | ! |
info->RegisterParameterName(ss.str()); |
| 432 | ! |
if (this->inflection_point_asc[i].is_random_effect_m) {
|
| 433 | ! |
info->RegisterRandomEffect(selectivity->inflection_point_asc[i]); |
| 434 |
} else {
|
|
| 435 | ! |
info->RegisterParameter(selectivity->inflection_point_asc[i]); |
| 436 |
} |
|
| 437 |
} |
|
| 438 |
} |
|
| 439 | ||
| 440 | ! |
info->variable_map[this->inflection_point_asc.id_m] = &(selectivity)->inflection_point_asc; |
| 441 | ||
| 442 | ||
| 443 | ! |
selectivity->slope_asc.resize(this->slope_asc.size()); |
| 444 | ! |
for (size_t i = 0; i < this->slope_asc.size(); i++) {
|
| 445 | ! |
selectivity->slope_asc[i] = this->slope_asc[i].initial_value_m; |
| 446 | ! |
if (this->slope_asc[i].estimated_m) {
|
| 447 | ! |
ss.str("");
|
| 448 | ! |
ss << "selectivity.slope_asc." << this->id << "." << i; |
| 449 | ! |
info->RegisterParameterName(ss.str()); |
| 450 | ! |
if (this->slope_asc[i].is_random_effect_m) {
|
| 451 | ! |
info->RegisterRandomEffect(selectivity->slope_asc[i]); |
| 452 |
} else {
|
|
| 453 | ! |
info->RegisterParameter(selectivity->slope_asc[i]); |
| 454 |
} |
|
| 455 |
} |
|
| 456 |
} |
|
| 457 | ! |
info->variable_map[this->slope_asc.id_m] = &(selectivity)->slope_asc; |
| 458 | ||
| 459 | ! |
selectivity->inflection_point_desc.resize(this->inflection_point_desc.size()); |
| 460 | ! |
for (size_t i = 0; i < this->inflection_point_desc.size(); i++) {
|
| 461 | ! |
selectivity->inflection_point_desc[i] = this->inflection_point_desc[i].initial_value_m; |
| 462 | ! |
if (this->inflection_point_desc[i].estimated_m) {
|
| 463 | ! |
ss.str("");
|
| 464 | ! |
ss << "selectivity.inflection_point_desc." << this->id << "." << i; |
| 465 | ! |
info->RegisterParameterName(ss.str()); |
| 466 | ! |
if (this->inflection_point_desc[i].is_random_effect_m) {
|
| 467 | ! |
info->RegisterRandomEffect(selectivity->inflection_point_desc[i]); |
| 468 |
} else {
|
|
| 469 | ! |
info->RegisterParameter(selectivity->inflection_point_desc[i]); |
| 470 |
} |
|
| 471 |
} |
|
| 472 |
} |
|
| 473 | ||
| 474 | ! |
info->variable_map[this->inflection_point_desc.id_m] = &(selectivity)->inflection_point_desc; |
| 475 | ! |
selectivity->slope_desc.resize(this->slope_desc.size()); |
| 476 | ! |
for (size_t i = 0; i < this->slope_desc.size(); i++) {
|
| 477 | ! |
selectivity->slope_desc[i] = this->slope_desc[i].initial_value_m; |
| 478 | ! |
if (this->slope_desc[i].estimated_m) {
|
| 479 | ! |
ss.str("");
|
| 480 | ! |
ss << "selectivity.slope_desc." << this->id << "." << i; |
| 481 | ! |
info->RegisterParameterName(ss.str()); |
| 482 | ! |
if (this->slope_desc[i].is_random_effect_m) {
|
| 483 | ! |
info->RegisterRandomEffect(selectivity->slope_desc[i]); |
| 484 |
} else {
|
|
| 485 | ! |
info->RegisterParameter(selectivity->slope_desc[i]); |
| 486 |
} |
|
| 487 |
} |
|
| 488 |
} |
|
| 489 | ||
| 490 | ||
| 491 | ! |
info->variable_map[this->slope_desc.id_m] = &(selectivity)->slope_desc; |
| 492 | ||
| 493 |
// add to Information |
|
| 494 | ! |
info->selectivity_models[selectivity->id] = selectivity; |
| 495 | ||
| 496 |
return true; |
|
| 497 |
} |
|
| 498 | ||
| 499 |
/** |
|
| 500 |
* @brief Adds the parameters to the TMB model. |
|
| 501 |
* @return A boolean of true. |
|
| 502 |
*/ |
|
| 503 | ! |
virtual bool add_to_fims_tmb() {
|
| 504 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_REAL_TYPE>(); |
| 505 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_FIRST_ORDER>(); |
| 506 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_SECOND_ORDER>(); |
| 507 | ! |
this->add_to_fims_tmb_internal<TMB_FIMS_THIRD_ORDER>(); |
| 508 | ||
| 509 | ! |
return true; |
| 510 |
} |
|
| 511 | ||
| 512 |
#endif |
|
| 513 |
}; |
|
| 514 | ||
| 515 |
#endif |
| 1 | ||
| 2 |
#include <cmath> |
|
| 3 | ||
| 4 |
#include "../inst/include/interface/rcpp/rcpp_interface.hpp" |
|
| 5 |
#include "../inst/include/interface/interface.hpp" |
|
| 6 |
#include "../inst/include/interface/init.hpp" |
|
| 7 |
#include "../inst/include/common/model.hpp" |
|
| 8 | ||
| 9 |
/// @cond |
|
| 10 |
/** |
|
| 11 |
* @brief TMB objective function |
|
| 12 |
* |
|
| 13 |
* @return Returns a joint negative log likelihood |
|
| 14 |
*/ |
|
| 15 |
template<class Type> |
|
| 16 | ! |
Type objective_function<Type>::operator()() {
|
| 17 | ||
| 18 | ||
| 19 | ! |
PARAMETER_VECTOR(p); |
| 20 | ||
| 21 |
// code below copied from ModularTMBExample/src/tmb_objective_function.cpp |
|
| 22 | ||
| 23 |
// get the singleton instance for Model Class |
|
| 24 |
std::shared_ptr<fims_model::Model<Type>> model = |
|
| 25 | ! |
fims_model::Model<Type>::GetInstance(); |
| 26 |
// get the singleton instance for Information Class |
|
| 27 |
std::shared_ptr<fims_info::Information<Type>> information = |
|
| 28 | ! |
fims_info::Information<Type>::GetInstance(); |
| 29 | ||
| 30 |
//update the parameter values |
|
| 31 | ! |
for(size_t i =0; i < information->fixed_effects_parameters.size(); i++){
|
| 32 | ! |
*information->fixed_effects_parameters[i] = p[i]; |
| 33 |
} |
|
| 34 | ! |
model -> of = this; |
| 35 | ||
| 36 |
//evaluate the model objective function value |
|
| 37 | ! |
Type nll = model->Evaluate(); |
| 38 | ||
| 39 | ! |
return nll; |
| 40 | ||
| 41 |
} |
|
| 42 |
/// @endcond |